1#!/usr/local/bin/perl -w
2# Some scripts for handling mailto URLs within lynx via an interactive form
3#
4# Warning: this is a quick demo, to show what kinds of things are possible
5# by hooking some external commands into lynx.  Use at your own risk.
6#
7# Requirements:
8#
9# - Perl and CGI.pm.
10# - A "sendmail" command for actually sending mail (if you need some
11#   other interface, change the code below in sub sendit appropriately).
12# - Lynx compiled with support for lynxcgi, that means EXEC_CGI must have
13#   been defined at compilation, usually done with
14#     ./configure --enable-cgi-links
15# - Lynx must have support for CERN-style rules as of 2.8.3, which must
16#   not have been disabled at compilation (it is enabled by default).
17#
18# Instructions:
19# (This is for people without lynxcgi experience; if you are already
20# use lynxcgi, you don't have to follow everything literally, use
21# common sense for picking appropriate file locations in your situation.)
22#
23# - Make a subdirectory 'lynxcgi' under you home directory, i.e.
24#      mkdir ~/lynxcgi
25# - Put this three script file mailto-form.pl there and make it
26#   executable.  For example,
27#      cp mailto-form.pl ~/lynxcgi
28#      chmod a+x ~/lynxcgi/mailto-form.pl
29# - Edit mailto-form.pl (THIS FILE), there are some strings that
30#   that need to be changed, see ### Configurable variables ###
31#   below.
32# - Allow lynx to execute lynxcgi files in that directory, for example,
33#   put in your lynx.cfg file:
34#      TRUSTED_LYNXCGI:<tab>/home/myhomedir/lynxcgi/mailto-form.pl
35#   where <tab> is a real TAB character and you have to put the real
36#   location of your directory in place of "myhomedir", of course.
37#   The '~' abbreviation cannot be used.
38#   You could also just enable execution of all lynxcgi scripts, by
39#   not having any TRUSTED_LYNXCGI options in lynx.cfg at all, but
40#   that can't be recommended.
41# - Tell lynx to actually use the lynxcgi scripts for mailto URLs.
42#   There are two variants:
43#   a) Redirect "mailto"
44#   Requires patched lynx, currently not yet in the developent code.
45#   Use the following two lines in the file that is configured as
46#   RULESFILE in lynxcfg:
47#      PermitRedirection mailto:*
48#      Redirect mailto:* lynxcgi:/home/myhomedir/lynxcgi/mailto-form.pl?from=myname@myhost&to=*
49#   You can also put them directly in lynx.cfg, prefixing each with
50#   "RULE:".  Replace ""myhomedir", "myname", and "myhost" with your
51#   correct values, of course.
52#   b) Redirect "xmailto"
53#   Requires defining a fake proxy before starting lynx, like
54#      export xmailto_proxy=dummy  # or for csh: setenv xmailto_proxy dummy
55#   Requires that you change "mailto" to "xmailto" each time you want
56#   to activate a mailto link.  This can be done conveniently with
57#   a few keys: 'E', ^A, 'x', Enter.
58#   Use the following two lines in the file that is configured as
59#   RULESFILE in lynxcfg:
60#      PermitRedirection xmailto:*
61#      Redirect xmailto:* lynxcgi:/home/myhomedir/lynxcgi/mailto-form.pl?from=myname@myhost&to=*
62#   You can also put them directly in lynx.cfg, prefixing each with
63#   "RULE:".  Replace ""myhomedir", "myname", and "myhost" with your
64#   correct values, of course.
65#
66# Limitations:
67#
68# - Only applies to mailto URLs that appear as links or are entered at
69#   a 'g'oto prompt.  Does not apply to other ways of sending mail, like
70#   the 'c' (COMMENT) key, mailto as a FORM action, or mailing a file
71#   from the 'P'rinting Options screen.
72# - Nothing is done for charset labelling, content-transfer-encoding
73#   of non-ASCII characters, and other MIME niceties.
74#
75# Klaus Weide 20000712
76
77########################################################################
78########## Configurable variables ######################################
79
80$SENDMAIL = '/usr/sbin/sendmail';
81#                                   The location of your sendmail binary
82$SELFURL = 'lynxcgi:/home/lynxdev/lynxcgi/mailto-form.pl';
83#                                   Where this script lives in URL space
84$SEND_TOKEN = '/vJhOp6eQ';
85#                           When found in the PATH_INFO part of the URL,
86#                           this causes the script to actually send mail
87#                           by calling $SENDMAIL instead of just throwing
88#                           up a form.  CHANGE IT!  And don't tell anyone!
89#                           Treat it like a password.
90#                           Must start with '/', probably should have only
91#                           alphanumeric ASCII characters.
92
93## Also, make sure the first line of this script points
94## to your PERL binary
95
96########## Nothing else to change - I hope #############################
97########################################################################
98
99use CGI;
100
101$|=1;
102
103### Upcase first character
104##sub ucfirst {
105##    s/^./\U$1/;
106##}
107
108# If there are multiple occurrences of the same thing, how to join them
109# into one string
110%joiner = (from => ', ',
111	   to => ', ',
112	   cc => ', ',
113	   subject => '; ',
114	   body => "\n\n"
115	   );
116sub joiner {
117    my ($key) = @_;
118    if ($joiner{$key}) {
119	$joiner{$key};
120    } else {
121	" ";
122    }
123}
124
125# Here we check whether this script is called for actual sending, rather
126# than form generation.  If so, all the rest is handled by sub sendit, below.
127$pathinfo = $ENV{'PATH_INFO'};
128if (defined($pathinfo) && $pathinfo eq $SEND_TOKEN) {
129    $q = new CGI;
130    print $q->header('text/plain');
131    sendit();
132    exit;
133}
134
135$method = $ENV{'REQUEST_METHOD'};
136$querystring = $ENV{'QUERY_STRING'};
137if ($querystring) {
138    if ($method && $method eq "POST" && $ENV{'CONTENT_LENGTH'}) {
139	$querystring =~ s/((^|\&)to=[^?&]*)\?/$1&/;
140	$q0 = new CGI;
141	$q = new CGI($querystring);
142	@fields = $q0->param();
143	foreach $key (@fields) {
144	    @vals = $q0->param($key);
145#	    print "Content-type: text/html\n\n";
146#	    print "Appending $key to \$q...\n";
147	    $q->append($key, @vals);
148#	    print "<H2>Current Values in \$q0</H2>\n";
149#	    print $q0->dump;
150#	    print "<H2>Current Values in \$q</H2>\n";
151#	    print $q->dump;
152
153	}
154
155    } else {
156	$querystring =~ s/((^|\&)to=[^?&]*)\?/$1&/;
157	$q = new CGI($querystring);
158    }
159} else {
160    $q = new CGI;
161}
162
163print $q->header;
164
165$long_title = $ENV{'QUERY_STRING'};
166$long_title =~ s/^from=([^&]*)\&to=//;
167$long_title = "someone" unless $long_title;
168$long_title = "Compose mail for $long_title";
169if (length($long_title) > 72) {
170    $title = substr($long_title,0,72) . "...";
171} else {
172    $title = $long_title;
173}
174$long_title =~ s/&/&amp;/g;
175$long_title =~ s/</&lt;/g;
176print
177    $q->start_html($title), "\n",
178    $q->h1($long_title), "\n",
179    $q->start_form(-method=>'POST', -action => $SELFURL . $SEND_TOKEN), "\n";
180
181print "<TABLE>\n";
182@fields = $q->param();
183foreach $key (@fields) {
184    @vals = $q->param($key);
185    if (scalar(@vals) != 1) {
186	print "multiple values " . scalar(@vals) ." for $key!\n";
187	$q->param($key, join (joiner($key), @vals));
188    }
189}
190foreach $key (@fields) {
191    $_ = lc($key);
192    if ($_ ne $key) {
193	print "noncanonical case for $key!\n";
194	$val=$q->param($key);
195	$q->delete($key);
196	if (!$q->param($_)) {
197	    $q->param($_, $val);
198	} else {
199	    $q->param($_, $q->param($_) . joiner($_) . "$val");
200	}
201    }
202}
203foreach $key ('from', 'to', 'cc', 'subject') {
204    print $q->Tr,
205    $q->td(ucfirst($key) . ":"),
206    $q->td($q->textfield(-name=>$key,
207			 -size=>60,
208			 -default=>$q->param($key))), "\n";
209    $q->delete($key);
210}
211
212# Also pass on any unrecognized header fields that were specified.
213# This may not be a good idea for general use!
214# At least some dangerous header fields may have to be suppressed.
215@keys = $q->param();
216if (scalar(@keys) > (($q->param('body')) ? 1 : 0)) {
217    print "<TR><TD colspan=2><EM>Additional headers:</EM>\n";
218    foreach $key ($q->param()) {
219	if ($key ne 'body') {
220	    print $q->Tr,
221	    $q->td(ucfirst($key) . ":"),
222	    $q->td($q->textfield(-name=>$key,
223				 -size=>60,
224				 -default=>$q->param($key))), "\n";
225	}
226    }
227}
228print "</TABLE>\n";
229print $q->textarea(-name=>'body',
230		   -default=>$q->param('body')), "\n";
231print "<PRE>\n\n</PRE>", "\n",
232    $q->submit(-value=>"Send the message"), "\n",
233    $q->endform, "\n";
234
235print "\n";
236exit;
237
238# This is for header field values.
239sub sanitize_field_value {
240    my($val) = @_;
241    $val =~ s/\0/./g;
242    $val =~ s/\r\n/\n/g;
243    $val =~ s/\r/\n/g;
244    $val =~ s/\n*$//g;
245    $val =~ s/\n+/\n/g;
246    $val =~ s/\n(\S)/\n\t$1/g;
247    $val;
248}
249
250sub sendit {
251    open (MAIL, "| $SENDMAIL -t -oi -v") || die ("$0: Can't run sendmail: $!\n");
252    @fields = $q->param();
253    foreach $key (@fields) {
254	@vals = $q->param($key);
255	if (scalar(@vals) != 1) {
256	    print "multiple values " . scalar(@vals) ." for $key!\n";
257	    $q->param($key, join (joiner($key), @vals));
258	}
259    }
260    foreach $key (@fields) {
261	if ($key ne 'body') {
262	    if ($key =~ /[^A-Za-z0-9_-]/) {
263		print "$0: Ignoring malformed header field named '$key'!\n";
264		next;
265	    }
266	    print MAIL ucfirst($key) . ": " .
267		sanitize_field_value($q->param($key)) . "\n"
268		or die ("$0: Feeding header to sendmail failed: $!\n");
269	}
270    }
271    print MAIL "\n"
272	or die ("$0: Ending header for sendmail failed: $!\n");
273    print MAIL $q->param('body'), "\n"
274	or die ("$0: Feeding body to sendmail failed: $!\n");
275    close(MAIL)
276	or warn $! ? "Error closing pipe to sendmail: $!"
277	    : ($? & 127) ? ("Sendmail killed by signal " . ($? & 127) .
278			    ($? & 127) ? ", core dumped" : "")
279		: "Return value " . ($? >> 8) . " from sendmail";
280}
281