#!/usr/local/bin/perl ############################################################################### # # # FAX.PL (Fist release) # # Scripting and testing by M. de Kok # # Code is free for personal use... # # # # For info and/or support mail: mdekok@adicted.to # # # # M.de kok # # Lingestraat 4 # # 6826 AL, GLD. # # Arnhem, Netherlands # # +31620377240 # # ICQ #9712917 # # # # Script @ work at: http://adicted.to/fax4free # # # ############################################################################### # use the Net::SMTP module.. (can be installed using PPM or VPM) use Net::SMTP; # Meta tags $tags = ''; # get data from form &parse_form; # organize data $r_name=$TAG{r_name}; $r_adrs=$TAG{r_adrs}; $r_number=$TAG{r_number}; $f_mail=$TAG{f_mail}; $subject=$TAG{subject}; $body=$TAG{body}; $job_done=$TAG{job_done}; # Create Date Stamp my($date,$min,$hour,$day,$month,$year,$weekday,$ampm,$zero,@weekdays,@months); (undef, $min, $hour, $day, $month, $year, $weekday) = localtime(time); @weekdays = ("Sunday","Monday","Tuesday","Wednesday", "Thursday","Friday","Saturday"); @months = ("January","February","March","April","May","June","July", "August","September","October","November","December"); # Dates correct through 2097 :) if ($year > 97) { $year += 1900; } else { $year += 2000; } # Fix Time if ($hour > 12) { $hour -= 12; $ampm = "PM"; } else { $ampm = "AM"; } if ($hour == 0) { $hour = 12; } if ($min < 10) { $zero = "0"; } else { $zero = ""; } $time = "$hour:$zero$min $ampm"; $date = "$weekdays[$weekday], $months[$month] $day, $year"; if ($job_done eq "on") { &mail_entry } $job_done="on"; # print HTML print ''; print <<"__HTML__" $tags fax4free

Cover Page

$message

Page 1 of 2

FACSIMILE TRANSMISSION

Please deliver this facsimile to:

*Recipients name:
*Recipients address:
*Recipients number:

From:

*Your email address:

Date:

$time

$date

Subject:

Subject of this fax:

Body

*Requied fields

Page 2 of 2

Body:

fax4free = a Adicted.to/service

__HTML__ ; exit; # SUBS sub parse_form { if ($ENV{'QUERY_METHOD'} eq "GET") { &error("GET"); } read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Split the name-value pairs @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); # Un-Webify plus signs and %-encoding $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # Stop people from using subshells to execute commands # Not a big deal when using sendmail, but very important # when using UCB mail (aka mailx). # $value =~ s/~!/ ~!/g; # Uncomment for debugging purposes # print "Setting $name to $value

"; $TAG{$name} = $value; } } sub mail_entry { # check address syntax if ($f_mail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || $f_mail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) { &error("mail_syntax"); } if ($subject eq "") { $subject = "Fax4Free is a service from adicted.to" } # Mail data to counter and user $smtp = Net::SMTP->new('adicted.to', Hello => 'SpankzMail.Rulez', Timeout => 30, Debug => 0); $smtp->mail('postmaster@adicted.to'); $smtp->to('counter@adicted.to'); $smtp->recipient($f_mail); $smtp->data(); $smtp->datasend("To: $f_mail\n"); $smtp->datasend("From: auto\@adicted.to\n"); $smtp->datasend("X-mailer: SpankZMailService v. 0.01t\n"); $smtp->datasend("Mime-Version: 1.0\n"); $smtp->datasend("Content-type: text/plain\n"); $smtp->datasend("Subject: $subject\n\n"); $smtp->datasend("__________________________\n\n"); $smtp->datasend("Fax send to: $r_name, $r_adrs\n"); $smtp->datasend("To fax number: $r_number\n"); $smtp->datasend("______________________________\nBody:\n\n"); $smtp->datasend("$body\n\n"); $smtp->datasend("______________________________\n\n"); $smtp->datasend("Your fax request has been accepted\n"); $smtp->datasend("for delivery on $r_number... The logs for this\n"); $smtp->datasend("facsimile wil be send to you soon by tpcadmin\@info.tpc.in"); $smtp->quit; # compose message for delivery on tcp... $info1 = $r_name; $info2 = $r_adrs; $info1 =~ s/ /_/g; $info2 =~ s/ /_/g; $r_info1 = $info1; $r_info2 = $info2; $compose = "remote-printer." . $r_info1 . "/" . $r_info2 . "\@" . $r_number . ".iddd.tpc.int"; # deliver request @ tcp $smtp = Net::SMTP->new('adicted.to', Hello => 'SpankzMail.Rulez', Timeout => 30, Debug => 0); $smtp->mail('postmaster@adicted.to'); $smtp->to('counter@adicted.to'); $smtp->recipient($compose); $smtp->data(); $smtp->datasend("To: TCP\n"); $smtp->datasend("From: $f_mail\n"); $smtp->datasend("X-mailer: SpankZMailService v. 0.01t\n"); $smtp->datasend("Mime-Version: 1.0\n"); $smtp->datasend("Content-type: text/plain\n"); $smtp->datasend("Subject: $subject\n\n"); $smtp->datasend("$body\n\n"); $smtp->quit; $message="Your facsimile has been added for delivery!"; $job_done=""; } sub error { my %ERR; $ERR{"not_ready"} = "Sorry, but this part of the service is under construction right now. your fax request however has been accepted for delivery on $number..."; $ERR{"mail_syntax"} = "[ $email ] is not an valide address!"; $ERR{"GET"} = "The script must be called with the POST method."; $ERR{"debug"} = "compose = $compose"; $ERR{"no_data"} = "All fields must by completed!"; my $emsg = $ERR{$_[0]}; if (!$emsg) { $emsg = "The script has suffered an unknown error."; } print "Content-type: text/html", "\n\n"; print "\n"; print "

Fax Error

\n"; print "$emsg"; print ""; exit; }