#! /usr/bin/perl -w

# Some scripts for handling mailto URLs within lynx via an interactive form

# 

# Warning: this is a quick demo, to show what kinds of things are possible

# by hooking some external commands into lynx.  Use at your own risk.

# 

# Requirements:

# 

# - Perl and CGI.pm.

# - A "sendmail" command for actually sending mail (if you need some

#   other interface, change the code below in sub sendit appropriately).

# - Lynx compiled with support for lynxcgi, that means EXEC_CGI must have

#   been defined at compilation, usually done with

#     ./configure --enable-cgi-links

# - Lynx must have support for CERN-style rules as of 2.8.3, which must

#   not have been disabled at compilation (it is enabled by default).

# 

# Instructions:

# (This is for people without lynxcgi experience; if you are already

# use lynxcgi, you don't have to follow everything literally, use

# common sense for picking appropriate file locations in your situation.)

# 

# - Make a subdirectory 'lynxcgi' under you home directory, i.e.

#      mkdir ~/lynxcgi

# - Put this three script file mailto-form.pl there and make it

#   executable.  For example,

#      cp mailto-form.pl ~/lynxcgi

#      chmod a+x ~/lynxcgi/mailto-form.pl

# - Edit mailto-form.pl (THIS FILE), there are some strings that

#   that need to be changed, see ### Configurable variables ###

#   below.

# - Allow lynx to execute lynxcgi files in that directory, for example,

#   put in your lynx.cfg file:

#      TRUSTED_LYNXCGI:<tab>/home/myhomedir/lynxcgi/mailto-form.pl

#   where <tab> is a real TAB character and you have to put the real

#   location of your directory in place of "myhomedir", of course.

#   The '~' abbreviation cannot be used.

#   You could also just enable execution of all lynxcgi scripts, by

#   not having any TRUSTED_LYNXCGI options in lynx.cfg at all, but

#   that can't be recommended.

# - Tell lynx to actually use the lynxcgi scripts for mailto URLs.

#   There are two variants:

#   a) Redirect "mailto"

#   Requires patched lynx, currently not yet in the developent code.

#   Use the following two lines in the file that is configured as

#   RULESFILE in lynxcfg:

#      PermitRedirection mailto:*

#      Redirect mailto:* lynxcgi:/home/myhomedir/lynxcgi/mailto-form.pl?from=myname@myhost&to=*

#   You can also put them directly in lynx.cfg, prefixing each with

#   "RULE:".  Replace ""myhomedir", "myname", and "myhost" with your

#   correct values, of course.

#   b) Redirect "xmailto"

#   Requires defining a fake proxy before starting lynx, like

#      export xmailto_proxy=dummy  # or for csh: setenv xmailto_proxy dummy

#   Requires that you change "mailto" to "xmailto" each time you want

#   to activate a mailto link.  This can be done conveniently with

#   a few keys: 'E', ^A, 'x', Enter.

#   Use the following two lines in the file that is configured as

#   RULESFILE in lynxcfg:

#      PermitRedirection xmailto:*

#      Redirect xmailto:* lynxcgi:/home/myhomedir/lynxcgi/mailto-form.pl?from=myname@myhost&to=*

#   You can also put them directly in lynx.cfg, prefixing each with

#   "RULE:".  Replace ""myhomedir", "myname", and "myhost" with your

#   correct values, of course.

# 

# Limitations:

# 

# - Only applies to mailto URLs that appear as links or are entered at

#   a 'g'oto prompt.  Does not apply to other ways of sending mail, like

#   the 'c' (COMMENT) key, mailto as a FORM action, or mailing a file

#   from the 'P'rinting Options screen.

# - Nothing is done for charset labelling, content-transfer-encoding

#   of non-ASCII characters, and other MIME niceties.

#

# Klaus Weide 20000712

########################################################################

########## Configurable variables ######################################

$SENDMAIL = '/usr/sbin/sendmail';

#                                   The location of your sendmail binary

$SELFURL = 'lynxcgi:/home/lynxdev/lynxcgi/mailto-form.pl';

#                                   Where this script lives in URL space

$SEND_TOKEN = '/vJhOp6eQ';

#                           When found in the PATH_INFO part of the URL,

#                           this causes the script to actually send mail

#                           by calling $SENDMAIL instead of just throwing

#                           up a form.  CHANGE IT!  And don't tell anyone!

#                           Treat it like a password.

#                           Must start with '/', probably should have only

#                           alphanumeric ASCII characters.

## Also, make sure the first line of this script points

## to your PERL binary

########## Nothing else to change - I hope #############################

########################################################################

use CGI;

$|=1;

### Upcase first character

##sub ucfirst {

##    s/^./\U$1/;

##}

# If there are multiple occurrences of the same thing, how to join them

# into one string

%joiner = (from => ', ',

	   to => ', ',

	   cc => ', ',

	   subject => '; ',

	   body => "\n\n"

	   );

sub joiner {

    my ($key) = @_;

    if ($joiner{$key}) {

	$joiner{$key};

    } else {

	" ";

    }

}

# Here we check whether this script is called for actual sending, rather

# than form generation.  If so, all the rest is handled by sub sendit, below.

$pathinfo = $ENV{'PATH_INFO'}; 

if (defined($pathinfo) && $pathinfo eq $SEND_TOKEN) {

    $q = new CGI;

    print $q->header('text/plain');

    sendit();

    exit;

}

$method = $ENV{'REQUEST_METHOD'};

$querystring = $ENV{'QUERY_STRING'};

if ($querystring) {

    if ($method && $method eq "POST" && $ENV{'CONTENT_LENGTH'}) {

	$querystring =~ s/((^|\&)to=[^?&]*)\?/$1&/;

	$q0 = new CGI;

	$q = new CGI($querystring);

	@fields = $q0->param();

	foreach $key (@fields) {

	    @vals = $q0->param($key);

#	    print "Content-type: text/html\n\n";

#	    print "Appending $key to \$q...\n";

	    $q->append($key, @vals);

#	    print "
Current Values in \$q0
\n";

#	    print $q0->dump;

#	    print "
Current Values in \$q
\n";

#	    print $q->dump;

	}

    } else {

	$querystring =~ s/((^|\&)to=[^?&]*)\?/$1&/;

	$q = new CGI($querystring);

    }

} else {

    $q = new CGI;

}

print $q->header;

$long_title = $ENV{'QUERY_STRING'};

$long_title =~ s/^from=([^&]*)\&to=//;

$long_title = "someone" unless $long_title;

$long_title = "Compose mail for $long_title";

if (length($long_title) > 72) {

    $title = substr($long_title,0,72) . "...";

} else {

    $title = $long_title;

}

$long_title =~ s/&/&/g;

$long_title =~ s/</</g;

print

    $q->start_html($title), "\n",

    $q->h1($long_title), "\n",

    $q->start_form(-method=>'POST', -action => $SELFURL . $SEND_TOKEN), "\n";

print "\n";

@fields = $q->param();

foreach $key (@fields) {

    @vals = $q->param($key);

    if (scalar(@vals) != 1) {

	print "multiple values " . scalar(@vals) ." for $key!\n";

	$q->param($key, join (joiner($key), @vals));

    }

}

foreach $key (@fields) {

    $_ = lc($key);

    if ($_ ne $key) {

	print "noncanonical case for $key!\n";

	$val=$q->param($key);

	$q->delete($key);

	if (!$q->param($_)) {

	    $q->param($_, $val);

	} else {

	    $q->param($_, $q->param($_) . joiner($_) . "$val");

	}

    }

}

foreach $key ('from', 'to', 'cc', 'subject') {

    print $q->Tr,

    $q->td(ucfirst($key) . ":"),

    $q->td($q->textfield(-name=>$key,

			 -size=>60,

			 -default=>$q->param($key))), "\n";

    $q->delete($key);

}

# Also pass on any unrecognized header fields that were specified.

# This may not be a good idea for general use!

# At least some dangerous header fields may have to be suppressed.

@keys = $q->param();

if (scalar(@keys) > (($q->param('body')) ? 1 : 0)) {

    print "Additional headers:\n";

    foreach $key ($q->param()) {

	if ($key ne 'body') {

	    print $q->Tr,

	    $q->td(ucfirst($key) . ":"),

	    $q->td($q->textfield(-name=>$key,

				 -size=>60,

				 -default=>$q->param($key))), "\n";

	}

    }

}

print "\n";

print $q->textarea(-name=>'body',

		   -default=>$q->param('body')), "\n";

print "
\n\n
", "\n",

    $q->submit(-value=>"Send the message"), "\n",

    $q->endform, "\n";

print "\n";

exit;

# This is for header field values.

sub sanitize_field_value {

    my($val) = @_;

    $val =~ s/\0/./g;

    $val =~ s/\r\n/\n/g;

    $val =~ s/\r/\n/g;

    $val =~ s/\n*$//g;

    $val =~ s/\n+/\n/g;

    $val =~ s/\n(\S)/\n\t$1/g;

    $val;

}

sub sendit {

    open (MAIL, "| $SENDMAIL -t -oi -v") || die ("$0: Can't run sendmail: $!\n");

    @fields = $q->param();

    foreach $key (@fields) {

	@vals = $q->param($key);

	if (scalar(@vals) != 1) {

	    print "multiple values " . scalar(@vals) ." for $key!\n";

	    $q->param($key, join (joiner($key), @vals));

	}

    }

    foreach $key (@fields) {

	if ($key ne 'body') {

	    if ($key =~ /[^A-Za-z0-9_-]/) {

		print "$0: Ignoring malformed header field named '$key'!\n";

		next;

	    }

	    print MAIL ucfirst($key) . ": " .

		sanitize_field_value($q->param($key)) . "\n"

		or die ("$0: Feeding header to sendmail failed: $!\n");

	}

    }

    print MAIL "\n"

	or die ("$0: Ending header for sendmail failed: $!\n");

    print MAIL $q->param('body'), "\n"

	or die ("$0: Feeding body to sendmail failed: $!\n");

    close(MAIL)

	or warn $! ? "Error closing pipe to sendmail: $!"

	    : ($? & 127) ? ("Sendmail killed by signal " . ($? & 127) .

			    ($? & 127) ? ", core dumped" : "")

		: "Return value " . ($? >> 8) . " from sendmail";

}