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/&/&/g; 175$long_title =~ s/</</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