#!/usr/local/bin/perl
# Doug Steinwand - dzs@iname.com
# ---------------------------------------------------------
# Sends a web page to someone's email address
# Someone needs to have an HTML-enabled email
# client to properly view the attached file. 
# Or, the user can save the file to disk and
# then load it into a web browser. However,
# this may not be too useful if used offline,
# because the HTML document will probably 
# contain links to a web site on the internet.
#
# Usage:
#  Call via a HREF such as the following:
#
#    <a href="/cgi-bin/sendurl.pl">Send This Page to Someone</a>
# 
# See below for custom settings on your web site.
# This script should be called sendurl.pl and be stored
# in your CGI-BIN directory.
#
# Use this week's CGI script to send content-
# rich HTML files in email.

# For more information on internet mail standards,
# see RFCs 822, 1521, 2110
# avalable at http://ds.internic.net/ds/dspg1intdoc.html

# ----- CUSTOMIZE THESE SETTINGS FOR YOUR WEB SITE:

# path and switches for the sendmail program on your system...
$SENDMAIL="/usr/sbin/sendmail -i -t -U -v -O ErrorMode=q";

# URL that the submitter will see after sending in the form
$successUrl="http://localhost/";

# default URL to send if HTTP_REFERER isn't defined
$defaultUrl="http://www.abiglime.com/webmaster";

# ----- END CUSTOM SETTINGS

# necessary perl modules
use Socket;
use FileHandle;

# process POST & GET data:
if ($ENV{'CONTENT_LENGTH'}) {
    # read POST
    read STDIN, $input, $ENV{'CONTENT_LENGTH'};
    # and GET
    $input.="&".$ENV{'QUERY_STRING'} if (length($ENV{'QUERY_STRING'}));
} else {
    # read GET
    $input=$ENV{'QUERY_STRING'};
}

# split the query string into separate keys and values
foreach (split(/[&;]/,$input)) {
    # Convert plus to space
    s/\+/ /g;
    # Split into key and value.  
    ($key, $val) = split(/=/,$_,2);

    # Convert %XX from hex numbers to alphanumeric
    $val =~ s/%([a-f0-9]{2})/pack("c",hex($1))/ige;

    # save lowercase key and value
    $in{lc($key)}=$val;
}
# the %in array now has keys and values

# retrieve person's name, remove cr/lf and escape quotes
$fromName=$in{'fromname'};
$fromName=~s/[\r\n]//g;
$fromName=~s/\"/\\\"/g;

# retrieve FROM email address, remove cr/lf, < and >
$fromEmail=$in{'fromemail'};
$fromEmail=~s/[<>\r\n]//g;

# retrieve user's message
$fromMessage=$in{'frommessage'};

# retrieve TO email address, remove cr/lf, < and >
$toEmail=$in{'toemail'};
$toEmail=~s/[<>\r\n]//g;

# get HTTP_REFERER or use default
$sendUrl=$in{'sendurl'} || $ENV{'HTTP_REFERER'} || $defaultUrl;

# check for message
unless (length($fromMessage)) {
    $fromMessage="Take a look at $sendUrl";
}

# display form plus error message if necessary
unless (length($fromName) && length($fromEmail) &&
	length($toEmail) && length($sendUrl)) {
    if (length($in{'button'})) {
	displayForm("<hr>You must enter all the requested information.");
    } else {
	displayForm();
    }
    exit 0;
}

# read first 100k bytes and save them
$urlHandle=openurl($sendUrl);
read $urlHandle, $htmlContent, 102400;
close $urlHandle;
# find content-type header
if ($htmlContent=~/Content-type:\s*(.+?)\r?\n/i) {
    $contentType=$1;
} else {
    $contentType="text/html";
}

# save only the stuff after the end of HTTP headers
$htmlContent=~s/^.+?(\r?\n){2}//s;

# retrieve title from html and use it as the message subject
if ($htmlContent=~m!<title\s*>(.+?)</title\s*>!i) {
    $subject=$1;
    # remove cr's and lf's
    $subject=~s/[\r\n]//g;
} else {
    $subject="Take a look at $sendUrl";
}

# generate a unique boundary string
$boundary="86A37EZUNIQUESTRiNG".time.$$;

# open pipe to sendmail and send the message...
open P, "| $SENDMAIL >/dev/null";
print P <<End_of_texT;
From: "$fromName" <$fromEmail>
To: $toEmail
Subject: $subject
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="$boundary"

--$boundary

$fromMessage

--$boundary
Content-Type: $contentType
Content-Transfer-Encoding: 7bit
Content-Disposition: inline
Content-Base: "$sendUrl"

$htmlContent

--$boundary--
End_of_texT
close P;

# redirect user to the correct url
print "Location: $successUrl\n\n";
exit 0;



# opens a socket and sends a request to retrieve a given url
# $socket = openurl("http://www.my.com/what.html", "HEAD");
sub openurl {
    my($url,$method)=@_;
    $method="GET" unless length $method;

    my($host,$port,$file)=spliturl($url);
    my($sock,$err)=opensock($host,$port);
    return 0,$err unless $sock;
    # send request
    print $sock "$method $file HTTP/1.0\n\n"; 
  
    # return handle to the open socket
    return $sock;
}

# returns host, port and file from a url
# ($host,$port,$file)=spliturl("http://somewhere.com:380/path/file");
sub spliturl {
    my ($url)=shift;
    my ($host,$port,$file);
 
    if ($url=~s!^http://!!i) { $port=80; }
    ($host,$file)=split(/\//,$url,2);  # split into hostname & file
    $file = "/$file";                  # add a leading /
    ($host,$aport)=split(/:/,$host,2); # get hostname & port
    $port=$aport if length $aport;

    return $host,$port,$file;
}

# opens a socket to the requested host and port
# $socket=opensock("www.someplace.com",80);
sub opensock {
    my ($host,$port)=@_;
    # get ip address
    my($addr)=getaddress($host)
        or return 0,"Host not found: $host";
    # create a handle for opening
    my $handle=new FileHandle;
    # create socket
    socket($handle,AF_INET,SOCK_STREAM, ((getprotobyname ('tcp'))[2]))
        or return 0,"Socket Error: $!";
    # connect socket
    connect($handle,pack("Snc4x8",2,$port,&getaddress($host)))
        or return 0,"Can't connect: $!";
    # enable autoflush on the socket
    $handle->autoflush(1);
    # return socket
    return $handle;
}

# returns unpacked host address
sub getaddress {
    my(@a);
    @a=gethostbyname(shift) or return;
    return(unpack("C4",$a[4]));
}

# displays the input form
sub displayForm {
    my($msg)=shift;
    print <<End_of_texT;
Content-type: text/html

<html>
<head>
 <title>Send a web page to...</title>
</head>
<body bgcolor="white" text="black">
<form method="post" action="/cgi-bin/sendurl.pl">
<input type="hidden" name="sendUrl" value="$sendUrl">

<table width=100%>
 <tr><td bgcolor="#b9b9b9">
  <font size=6><b>Send a web page to...</b></font></td></tr>
 <tr><td>
  This form will send the contents of the web page (URL) below to 
  the email address that you specify. You may enter a message 
  be sent along with the web page<a href="#note">*</a>. 
  Remember to include your name 
  and email adress.
 </td></tr>
</table>
$msg
<hr>
<table width=100%>
 <tr>
  <td>URL:</td>
  <td>$sendUrl</td>
 </tr>

 <tr>
  <td>Email Address:</td>
  <td><input type="text" size=50 name="toEmail" value="$toEmail"></td>
 </tr>
 <tr>
  <td>Comments:<br> 
      <font size=2>(to be included in the message)</font></td>
  <td><textarea name="fromMessage" rows=6 cols=50 wrap="hard">$fromMessage</textarea>
  </td>
 </tr>
 <tr>
  <td>Your Name:</td>
  <td><input type="text" size=50 name="fromName" value="$fromName"></td>
 </tr>
 <tr>
  <td>Your Email Address:</td>
  <td><input type="text" size=50 name="fromEmail" value="$fromEmail"></td>
 </tr>
</table>
<hr>
<table width=100%>
 <tr><td bgcolor="#b9b9b9" align=center>
  <input type="submit" name="button" value="Press here to submit form">
 </td></tr>
</table>
</form>
<font size=2>
 <a name="note">Note:</a> The reciepient of the message will need
 a MIME-compliant email reader, such as Eudora, Netscape Navigator 3.0+, 
 Microsoft Outlook, or Pine, to properly read the message and contents 
 of the web page. Unfortunately, some versions of AOL and some free email 
 services do not properly decode MIME 1.0 messages. 
 MIME email.
</font>

</body>
</html>
End_of_texT
}