and <body> tags) # 6) Create file "Contact.Themes/Default/Footer" with any footer you want. # 7) Optionally create file "Contact.Themes/Default/Agree" similar to: # "I will not use this contact form for solicitation purposes:" # 8) Create two keys: "Contact.Themes/CheckKey" and "Contact.Themes/Default/key" # A key is a one-line file with about 20 or so random characters. # ################################################## use strict; umask 0022; ################################################## # SETTINGS ################################################## my $HOST = $ENV{HTTP_HOST} || $ENV{SERVER_NAME} || "GetDave.com"; $HOST="lo:3001" if $ENV{PWD} eq "/data/proj/Contact"; # Development kludge! my $CGI = $ENV{REQUEST_URI} || "/cgi-bin/Contact.cgi"; # Guess if REFERER not f $CGI =~ s/[\&\?][^\/]+$//; my $URL = "http://$HOST$CGI"; # Theme directory (absolute filesystem path, *not* a URL) my $THEME_DIR = "/WWW/cgi-bin/Contact.Themes"; # Theme. Does %substitution if desired. If file not found, use Default # Example: http://Bob.GetDave.com/Contact.cgi # %s -> subdomain bob # %d -> domain getdave.com # %h -> host bob.getdave.com # %c -> CGI Contact # my $THEME = "%h"; # Now create files: (key, Header, Footer) in $THEME_DIR/$THEME/ # key is a one-line file with the key for that theme. # Header and Footer contain exactly what you would expect. # A check key which is just used to make sure they don't forge *their* email # It is saved in this file in $THEME_DIR my $CHECK_KEY = "CheckKey"; ######################### # Where is sendmail? (forge_pipe is best!) ######################### # forge_pipe works best, see: http://MarginalHacks.com/#forge my $SENDMAIL = "/usr/local/sbin/forge_pipe"; $SENDMAIL = "/usr/bin/forge_pipe" unless -x $SENDMAIL; $SENDMAIL = "/usr/sbin/forge_pipe" unless -x $SENDMAIL; $SENDMAIL = "/usr/sbin/sendmail" unless -x $SENDMAIL; $SENDMAIL = "/usr/lib/sendmail" unless -x $SENDMAIL; $SENDMAIL = "/usr/bin/sendmail" unless -x $SENDMAIL; # Do we wrap the $SENDMAIL call in sudo? # Requires an entry in /etc/sudoers: # <webuser> <hostname> = NOPASSWD: <path_to_sendmail> # For example: # apache getdave = NOPASSWD: /usr/local/sbin/forge_pipe my $USE_SUDO = 0; # And where is sudo? my $SUDO = "/usr/bin/sudo"; $USE_SUDO = 0 unless -x $SUDO; my $DEFAULT_NAME = "your recipient"; ################################################## # END OF SETTINGS ################################################## # You shouldn't need to change anything below here ################################################## ################################################## ################################################## ################################################## ################################################## # Query ################################################## sub from_url($) { my ($str) = @_; $str =~ s/\+/ /g; $str =~ s/%([0-9a-f]{2})/chr(hex($1))/eig; $str; } sub to_url($) { my ($str) = @_; $str =~ s/([^ a-zA-Z0-9\.])/"%".sprintf("%0.2x",ord($1))/eg; $str =~ s/ /+/g; $str; } sub parse_query { # Get query my $query_string; if ($ENV{REQUEST_METHOD} eq "POST") { read(STDIN,$query_string,$ENV{CONTENT_LENGTH}); } elsif ($ENV{QUERY_STRING}) { $query_string = $ENV{QUERY_STRING}; } chomp($query_string); # Split query # $query_string is of the form: "variable=value&var2=val2&.." my @querys=split(/[\&\?]/,$query_string); my (%query,$var,$val); foreach my $str (@querys) { $var = $str if (!(($var,$val) = ($str =~ /([^=]*)=(.*)/))); $val = 1 unless defined $val; $query{$var} = from_url($val) unless $var eq "RAW"; $query{RAW}{$var} = $val; } #header(1); show_values(\%query); \%query; } sub show_values { my ($query) = @_; header(); print "<p><hr><p>\n\n"; foreach my $q ( keys %$query ) { print "yo $q -> $query->{$q}<br>\n"; } } ################################################## # Encryption.. Ooh, ahh! ################################################## # You can pick one of the two methods below. Just comment one of these out. ################################################## # Method 1: Obfuscated, not strong. Shorter URLs ################################################## my @c = ("a".."z"," ","A".."Z",1..9); push(@c, qw(! @ # $ & *  . + - _ )); push(@c,"\\"); my %c; for(my $i=0;$i<=$#c;$i++) {$c{$c[$i]}=$i;} sub encrypt { my $i=0; join('',map {defined$c{$_}?$c[($c{$_}+(ord(substr($_[0],++$i%length$_[0],1))))%@c]:$_} split(//,reverse join("@",reverse split('\@',$_[1],-1)))); } sub decrypt { my $i=0; reverse join("@",reverse split('\@', join('',map {defined$c{$_}?$c[($c{$_}-(ord(substr($_[0],++$i%length$_[0],1))))%@c]:$_} split(//,$_[1])),-1)); } ################################################## # Method 2: Strong, but longer URLs, requires packages ################################################## # #http://search.cpan.org/author/LDS/Crypt-CBC-2.08/CBC.pm #use Crypt::CBC; # #http://search.cpan.org/author/DPARIS/Crypt-Blowfish-2.09/Blowfish.pm #use MIME::Base64; #sub encrypt { # my ($key,$str) = @_; # my $cipher = Crypt::CBC->new( {'key' => $key, 'cipher' => 'Crypt::Blowfish' }) # my $ciphertext = encode_base64 $cipher->encrypt($str); # chomp($ciphertext); # $ciphertext; #} # #sub decrypt { # my ($key,$str) = @_; # my $cipher = Crypt::CBC->new( {'key' => $key, 'cipher' => 'Crypt::Blowfish' }) # $cipher->decrypt(decode_base64 $str); #} ################################################## # HTML ################################################## my $DID_HEADER=0; sub header { my ($theme) = @_; return if $DID_HEADER++; print <<HEADER; Content-type: text/html $theme->{Header} HEADER } sub ERROR { header(); print "<h2>ERROR: @_</h2>\n"; undef; } sub FATAL { header($_[1]); print "<h2>ERROR: $_[0]</h2>\n"; footer($_[1]); exit(0); } sub footer { my ($theme) = @_; my $foot = $theme->{Footer}; $foot .= "</body>\n</html>\n" unless $foot =~ m|</body|; my $me = $CGI; $me =~ s|.*/||; my $note = <<NOTE; <p> <center> <a href='http://MarginalHacks.com/Hacks/Contact/'>$me</a> by <a href='http://GetDave.com/'>Dave's</a> <a href='http://MarginalHacks.com/'>Marginal Hacks</a> </center> NOTE $foot =~ s|</body|$note</body|; return unless $DID_HEADER; print <<GOBBLE_FOOTER; $foot GOBBLE_FOOTER } # Send mail sub send_mail { my ($to,$cc,$subject,$from,$from_full,$msg) = @_; my $sendmail = $USE_SUDO ? "$SUDO $SENDMAIL" : $SENDMAIL; return ERROR("Can't open sendmail pipe!") unless open(MAIL,"|$sendmail -i -f $from -F \"$from_full\" -t"); $to.="\nCc: $cc" if $cc && $cc ne $to; print MAIL <<MAIL_MESSAGE; From: "$from_full" <$from> Subject: $subject To: $to X-Mailer: $URL $msg MAIL_MESSAGE close MAIL; return 1; } ################################################## # Theme code ################################################## sub slurp($) { my ($file) = @_; open(SLURP,"<$file") || return ""; my @c = <SLURP>; close SLURP; wantarray ? @c : join("",@c); } sub get_theme() { my %theme; (-d $THEME_DIR) || FATAL("Can't read theme directory!"); my $theme = $THEME; my ($sub,$dom) = ($HOST=~/((.*)\.)?([^\.]+\.[^\.]+)/) ? ($2,$3) : ("",$HOST); my $cgi = $CGI; $cgi =~ s|.*/||g; $cgi =~ s|\.cgi||g; $theme =~ s/%s/$sub/g; $theme =~ s/%d/$dom/g; $theme =~ s/%h/$HOST/g; $theme =~ s/%c/$cgi/g; my $save = $theme; (-d "$THEME_DIR/$theme") || ($theme="Default"); (-d "$THEME_DIR/$theme") || FATAL("Couldn't find theme or default [$THEME_DIR/$save]!"); foreach my $slurp ( qw(key Header Footer Agree CC sig) ) { $theme{$slurp} = slurp "$THEME_DIR/$theme/$slurp"; } chomp($theme{key}); chomp($theme{CC}); FATAL("No key specified for theme (or not readable)") unless $theme{key}; $theme{CheckKey} = slurp "$THEME_DIR/$CHECK_KEY"; chomp($theme{CheckKey}); FATAL("No check key [$CHECK_KEY] found in the THEME_DIR") unless $theme{CheckKey}; $theme{sig} = $theme{sig} || <<SIG; --------------------------------------------------------------------------- This was delivered by the Contact Requestor CGI script running at http://$HOST If you did not request this email, please ignore it, or visit $HOST and contact the site admin. Script created by http://MarginalHacks.com/Hacks/Contact/ --------------------------------------------------------------------------- SIG header(\%theme); \%theme; } ################################################## # Queries ################################################## # Make sure a string is at least as long as another string (by repeating it) sub lengthen($$) { my ($str,$by) = @_; my $ls = length($str); my $lb = length($by); return $str if $lb <= $ls; $str = $str x (int($lb/$ls)+1); substr($str,0,$lb); } sub verify { my ($query,$theme) = @_; my $from = $query->{f}; $from =~ s/^\s+//; $from =~ s/\s+$//; FATAL("Bad email, please use the full URL sent to you",$theme) unless ($from =~ /(\S+)\@\S+\.\S/); FATAL("Bad email, please use the full URL sent to you",$theme) if length($from)<7; FATAL("Bad URL, please use the full URL sent to you",$theme) unless $query->{c}; # Verify that they didn't just constructed the URL my $c=lengthen($theme->{CheckKey},$from); FATAL("Bad URL, please use the full URL sent to you.",$theme) unless $c eq decrypt($from,$query->{c}); $from; } sub handle_mail_form { my ($query,$theme) = @_; my $from = verify($query,$theme); unless ($query->{message}) { ERROR("Empty message - try again"); return mail_form($query,$theme); } unless ($query->{subject}) { ERROR("Empty subject - try again"); return mail_form($query,$theme); } my $to = decrypt($theme->{key},$query->{t}); my $cc = ($query->{cc} && $theme->{CC}) ? $theme->{CC} : 0; my $msg = "$query->{message}\n\n$theme->{sig}"; send_mail($to,$cc,"[CONTACT] $query->{subject}",$from,$from,$msg); print "<p><br>Your mail has been sent.<p>\n"; } sub mail_form { my ($query,$theme) = @_; my $from = verify($query,$theme); my $subject = $query->{subject}; $subject =~ s/"/"/g; my $message = $query->{message}; $message =~ s|</textarea|</textarea|g; # CC? my $CC=""; if ($theme->{CC}) { $CC = <<CC; <tr> <td>CC:</td> <td> <input type='checkbox' name='cc' checked value='yes'> <i>$theme->{CC}</i> </td> </tr> CC } print <<MAIL_FORM; <p> <form action='$URL' method='POST' name='mail_form'> <table> <tr> <td>From:</td> <td><i>$from</i></td> </tr> <tr> <td>To:</td> <td><i>$query->{n}</i></td> </tr> $CC <tr> <td>Subject:</td> <td><input type='text' name='subject' size='40' value="$subject"></td> </tr> <tr> <td>Message:</td> <td align='right'><input type='submit' name='handle_mail_form' value='Send'></td> </tr> <tr> <td colspan='2'> <input type='hidden' name='t' value='$query->{t}'> <input type='hidden' name='c' value='$query->{c}'> <input type='hidden' name='f' value='$query->{f}'> <input type='hidden' name='n' value='$query->{n}'> <textarea name='message' rows='10' cols='75' wrap='soft'>$message</textarea> </td> </tr> <tr> <td colspan='2' align='right'><input type='submit' name='handle_mail_form' value='Send'></td> </tr> </table> </form> MAIL_FORM } sub handle_get_email { my ($query,$theme) = @_; # Verify that we haven't been swindled! if ($theme->{Agree} && !$query->{agree}) { ERROR("You didn't check the agreement box!"); return get_email($query,$theme); } # Avoid long emails that can be used to figure out the key my $from = $query->{f}; $from =~ s/^\s+//; $from =~ s/\s+$//; my $fromurl = to_url($from); if ($from !~ /(\S+)\@\S+\.\S/) { ERROR("Bad email, try again"); return get_email($query,$theme); } if (length($1) > 40) { ERROR("Email login [$1] too long"); return get_email($query,$theme); } # Shortest email would be something like x@xx.xx (7 characters) if (length($from)<7) { ERROR("Email too short"); return get_email($query,$theme); } # Encrypt a check key with their email address # (Okay, so it's not perfect, but nothing will be without strong encryption..) my $c=lengthen($theme->{CheckKey},$from); my $check = to_url encrypt($from,$c); # my $un = decrypt($from,from_url $check); my $n = $query->{n} eq $DEFAULT_NAME ? "" : ("&n=".to_url $query->{n}); send_mail($from,0,"URL to contact $query->{n}",$from,$from,<<MESSAGE_URL); To finish contacting $query->{n}, go to the following URL: $URL?t=$query->{t}&f=$fromurl&c=$check$n [Make sure to paste in the *full* URL above!] $theme->{sig} MESSAGE_URL print <<SENT_URL <p> A URL has been sent to: $from <p> You should be receiving it shortly. <p> When you visit that URL, you will be able to compose a message to $query->{n} <p> SENT_URL } sub get_email { my ($query,$theme) = @_; my $agree = $theme->{Agree}; $agree = "<br>$agree <input type='checkbox' name='agree' value='yes'>\n" if $agree; my $who = $query->{n} eq $DEFAULT_NAME ? "this person" : $query->{n}; # Well, it's not perfect, but it'll catch some cases my $t=decrypt($theme->{key},$query->{t}); FATAL("Your URL was corrupted<br>Make sure you have the full, correct URL") if ($t !~ /\@.*\./); print <<GET_EMAIL; <p> To send email to $who, you need to give us your email address: <br> <font color='red' size='-1'>For "why?" see explanation below</font> <br> <form action='$URL' method='POST' name='get_email'> <input type='hidden' name='t' value='$query->{RAW}{t}'> <input type='hidden' name='n' value='$query->{n}'> Your email address: <input type='text' name='f' size='30' maxsize='200' value='$query->{f}'> <input type='submit' name='handle_get_email' value='Submit'> $agree </form> <p><hr><p> <a name='why'><i>Why?</i></a> <font size='-1'> <p> We're using this mailing system because: <ol> <li> We don't want to give out our email address <li> We don't want forged email </ol> The only solution for this is a simple two-step process. Here's how it works: <ol> <li> You clicked on a link to contact $query->{n}, and got to this page. <li> You enter your email address, and a second URL is emailed to you. You can use then use that URL to compose the email. </ol> If we don't take the second step, then we don't have anyway to verify your email, and we don't want to be doing that, now do we? </font> <p> GET_EMAIL } sub empty_form { my ($theme) = @_; FATAL("No query<p>\nyou need to link to this from another page",$theme); } ################################################## # Do it ################################################## sub main { if (@ARGV) { die("Usage: $0 <key> <text>\n") unless $#ARGV==1; print "Decrypt: ",decrypt(@ARGV),"\nEncrypt: ",encrypt(@ARGV),"\n"; exit; } my $theme = get_theme; my $query = parse_query(); $query->{n} = $query->{n} || $DEFAULT_NAME; if ($query->{handle_get_email}) { handle_get_email($query,$theme); } elsif ($query->{handle_mail_form}) { handle_mail_form($query,$theme); } elsif ($query->{f}) { mail_form($query,$theme); } elsif ($query->{t}) { get_email($query,$theme); } else { empty_form($theme); } footer($theme); # If we need did the default header } main();

#!/usr/bin/perl # Filename: Contact.cgi # Author: David Ljung Madison # See License: http://MarginalHacks.com/License # Version: 1.14 # Description: Verified mailing without giving out email addresses! # ################################################## # HOW IT WORKS (also see 'INSTALLATION' below) ################################################## # Uses simple encrypt/decrypt. # # First encrypt an email address and then make a link of the form: # http://domain.com/Contact.cgi?t=ENCRYPTED_EMAIL # (To encrypt/decrypt strings you can call the CGI from the command line) # # You can add real names with: # http://domain.com/Contact.cgi?t=ENCRYPTED_EMAIL&n=Full+Name # # Users sent to that link will see a form where they can enter *their* email. # A second link will be sent to that email which takes them to an email form. # It verifies their email address, yet they never get your email! # # It's themeable too, based on domains, subdomains and/or CGI name. Groovy. # # For stronger encryption but longer URLS, see encrypt()/decrypt() below ################################################## # ################################################## # INSTALLATION ################################################## # # 1) Edit the SETTINGS section below # 2) Put this in your cgi-bin directory and make # it readable/executable by your web server. # 3) Create a directory "Contact.Themes/" in your cgi-bin directory # 4) Create a directory called "Contact.Themes/Default/" # You can also create themes here based upon hostname and $THEME below. # 5) Create file "Contact.Themes/Default/Header" with header # (be sure to include and <body> tags) # 6) Create file "Contact.Themes/Default/Footer" with any footer you want. # 7) Optionally create file "Contact.Themes/Default/Agree" similar to: # "I will not use this contact form for solicitation purposes:" # 8) Create two keys: "Contact.Themes/CheckKey" and "Contact.Themes/Default/key" # A key is a one-line file with about 20 or so random characters. # ################################################## use strict; umask 0022; ################################################## # SETTINGS ################################################## my $HOST = $ENV{HTTP_HOST} || $ENV{SERVER_NAME} || "GetDave.com"; $HOST="lo:3001" if $ENV{PWD} eq "/data/proj/Contact"; # Development kludge! my $CGI = $ENV{REQUEST_URI} || "/cgi-bin/Contact.cgi"; # Guess if REFERER not f $CGI =~ s/[\&\?][^\/]+$//; my $URL = "http://$HOST$CGI"; # Theme directory (absolute filesystem path, *not* a URL) my $THEME_DIR = "/WWW/cgi-bin/Contact.Themes"; # Theme. Does %substitution if desired. If file not found, use Default # Example: http://Bob.GetDave.com/Contact.cgi # %s -> subdomain bob # %d -> domain getdave.com # %h -> host bob.getdave.com # %c -> CGI Contact # my $THEME = "%h"; # Now create files: (key, Header, Footer) in $THEME_DIR/$THEME/ # key is a one-line file with the key for that theme. # Header and Footer contain exactly what you would expect. # A check key which is just used to make sure they don't forge *their* email # It is saved in this file in $THEME_DIR my $CHECK_KEY = "CheckKey"; ######################### # Where is sendmail? (forge_pipe is best!) ######################### # forge_pipe works best, see: http://MarginalHacks.com/#forge my $SENDMAIL = "/usr/local/sbin/forge_pipe"; $SENDMAIL = "/usr/bin/forge_pipe" unless -x $SENDMAIL; $SENDMAIL = "/usr/sbin/forge_pipe" unless -x $SENDMAIL; $SENDMAIL = "/usr/sbin/sendmail" unless -x $SENDMAIL; $SENDMAIL = "/usr/lib/sendmail" unless -x $SENDMAIL; $SENDMAIL = "/usr/bin/sendmail" unless -x $SENDMAIL; # Do we wrap the $SENDMAIL call in sudo? # Requires an entry in /etc/sudoers: # <webuser> <hostname> = NOPASSWD: <path_to_sendmail> # For example: # apache getdave = NOPASSWD: /usr/local/sbin/forge_pipe my $USE_SUDO = 0; # And where is sudo? my $SUDO = "/usr/bin/sudo"; $USE_SUDO = 0 unless -x $SUDO; my $DEFAULT_NAME = "your recipient"; ################################################## # END OF SETTINGS ################################################## # You shouldn't need to change anything below here ################################################## ################################################## ################################################## ################################################## ################################################## # Query ################################################## sub from_url($) { my ($str) = @_; $str =~ s/\+/ /g; $str =~ s/%([0-9a-f]{2})/chr(hex($1))/eig; $str; } sub to_url($) { my ($str) = @_; $str =~ s/([^ a-zA-Z0-9\.])/"%".sprintf("%0.2x",ord($1))/eg; $str =~ s/ /+/g; $str; } sub parse_query { # Get query my $query_string; if ($ENV{REQUEST_METHOD} eq "POST") { read(STDIN,$query_string,$ENV{CONTENT_LENGTH}); } elsif ($ENV{QUERY_STRING}) { $query_string = $ENV{QUERY_STRING}; } chomp($query_string); # Split query # $query_string is of the form: "variable=value&var2=val2&.." my @querys=split(/[\&\?]/,$query_string); my (%query,$var,$val); foreach my $str (@querys) { $var = $str if (!(($var,$val) = ($str =~ /([^=]*)=(.*)/))); $val = 1 unless defined $val; $query{$var} = from_url($val) unless $var eq "RAW"; $query{RAW}{$var} = $val; } #header(1); show_values(\%query); \%query; } sub show_values { my ($query) = @_; header(); print "<p><hr><p>\n\n"; foreach my $q ( keys %$query ) { print "yo $q -> $query->{$q}<br>\n"; } } ################################################## # Encryption.. Ooh, ahh! ################################################## # You can pick one of the two methods below. Just comment one of these out. ################################################## # Method 1: Obfuscated, not strong. Shorter URLs ################################################## my @c = ("a".."z"," ","A".."Z",1..9); push(@c, qw(! @ # $ & *  . + - _ )); push(@c,"\\"); my %c; for(my $i=0;$i<=$#c;$i++) {$c{$c[$i]}=$i;} sub encrypt { my $i=0; join('',map {defined$c{$_}?$c[($c{$_}+(ord(substr($_[0],++$i%length$_[0],1))))%@c]:$_} split(//,reverse join("@",reverse split('\@',$_[1],-1)))); } sub decrypt { my $i=0; reverse join("@",reverse split('\@', join('',map {defined$c{$_}?$c[($c{$_}-(ord(substr($_[0],++$i%length$_[0],1))))%@c]:$_} split(//,$_[1])),-1)); } ################################################## # Method 2: Strong, but longer URLs, requires packages ################################################## # #http://search.cpan.org/author/LDS/Crypt-CBC-2.08/CBC.pm #use Crypt::CBC; # #http://search.cpan.org/author/DPARIS/Crypt-Blowfish-2.09/Blowfish.pm #use MIME::Base64; #sub encrypt { # my ($key,$str) = @_; # my $cipher = Crypt::CBC->new( {'key' => $key, 'cipher' => 'Crypt::Blowfish' }) # my $ciphertext = encode_base64 $cipher->encrypt($str); # chomp($ciphertext); # $ciphertext; #} # #sub decrypt { # my ($key,$str) = @_; # my $cipher = Crypt::CBC->new( {'key' => $key, 'cipher' => 'Crypt::Blowfish' }) # $cipher->decrypt(decode_base64 $str); #} ################################################## # HTML ################################################## my $DID_HEADER=0; sub header { my ($theme) = @_; return if $DID_HEADER++; print <<HEADER; Content-type: text/html $theme->{Header} HEADER } sub ERROR { header(); print "<h2>ERROR: @_</h2>\n"; undef; } sub FATAL { header($_[1]); print "<h2>ERROR: $_[0]</h2>\n"; footer($_[1]); exit(0); } sub footer { my ($theme) = @_; my $foot = $theme->{Footer}; $foot .= "</body>\n</html>\n" unless $foot =~ m|</body|; my $me = $CGI; $me =~ s|.*/||; my $note = <<NOTE; <p> <center> <a href='http://MarginalHacks.com/Hacks/Contact/'>$me</a> by <a href='http://GetDave.com/'>Dave's</a> <a href='http://MarginalHacks.com/'>Marginal Hacks</a> </center> NOTE $foot =~ s|</body|$note</body|; return unless $DID_HEADER; print <<GOBBLE_FOOTER; $foot GOBBLE_FOOTER } # Send mail sub send_mail { my ($to,$cc,$subject,$from,$from_full,$msg) = @_; my $sendmail = $USE_SUDO ? "$SUDO $SENDMAIL" : $SENDMAIL; return ERROR("Can't open sendmail pipe!") unless open(MAIL,"|$sendmail -i -f $from -F \"$from_full\" -t"); $to.="\nCc: $cc" if $cc && $cc ne $to; print MAIL <<MAIL_MESSAGE; From: "$from_full" <$from> Subject: $subject To: $to X-Mailer: $URL $msg MAIL_MESSAGE close MAIL; return 1; } ################################################## # Theme code ################################################## sub slurp($) { my ($file) = @_; open(SLURP,"<$file") || return ""; my @c = <SLURP>; close SLURP; wantarray ? @c : join("",@c); } sub get_theme() { my %theme; (-d $THEME_DIR) || FATAL("Can't read theme directory!"); my $theme = $THEME; my ($sub,$dom) = ($HOST=~/((.*)\.)?([^\.]+\.[^\.]+)/) ? ($2,$3) : ("",$HOST); my $cgi = $CGI; $cgi =~ s|.*/||g; $cgi =~ s|\.cgi||g; $theme =~ s/%s/$sub/g; $theme =~ s/%d/$dom/g; $theme =~ s/%h/$HOST/g; $theme =~ s/%c/$cgi/g; my $save = $theme; (-d "$THEME_DIR/$theme") || ($theme="Default"); (-d "$THEME_DIR/$theme") || FATAL("Couldn't find theme or default [$THEME_DIR/$save]!"); foreach my $slurp ( qw(key Header Footer Agree CC sig) ) { $theme{$slurp} = slurp "$THEME_DIR/$theme/$slurp"; } chomp($theme{key}); chomp($theme{CC}); FATAL("No key specified for theme (or not readable)") unless $theme{key}; $theme{CheckKey} = slurp "$THEME_DIR/$CHECK_KEY"; chomp($theme{CheckKey}); FATAL("No check key [$CHECK_KEY] found in the THEME_DIR") unless $theme{CheckKey}; $theme{sig} = $theme{sig} || <<SIG; --------------------------------------------------------------------------- This was delivered by the Contact Requestor CGI script running at http://$HOST If you did not request this email, please ignore it, or visit $HOST and contact the site admin. Script created by http://MarginalHacks.com/Hacks/Contact/ --------------------------------------------------------------------------- SIG header(\%theme); \%theme; } ################################################## # Queries ################################################## # Make sure a string is at least as long as another string (by repeating it) sub lengthen($$) { my ($str,$by) = @_; my $ls = length($str); my $lb = length($by); return $str if $lb <= $ls; $str = $str x (int($lb/$ls)+1); substr($str,0,$lb); } sub verify { my ($query,$theme) = @_; my $from = $query->{f}; $from =~ s/^\s+//; $from =~ s/\s+$//; FATAL("Bad email, please use the full URL sent to you",$theme) unless ($from =~ /(\S+)\@\S+\.\S/); FATAL("Bad email, please use the full URL sent to you",$theme) if length($from)<7; FATAL("Bad URL, please use the full URL sent to you",$theme) unless $query->{c}; # Verify that they didn't just constructed the URL my $c=lengthen($theme->{CheckKey},$from); FATAL("Bad URL, please use the full URL sent to you.",$theme) unless $c eq decrypt($from,$query->{c}); $from; } sub handle_mail_form { my ($query,$theme) = @_; my $from = verify($query,$theme); unless ($query->{message}) { ERROR("Empty message - try again"); return mail_form($query,$theme); } unless ($query->{subject}) { ERROR("Empty subject - try again"); return mail_form($query,$theme); } my $to = decrypt($theme->{key},$query->{t}); my $cc = ($query->{cc} && $theme->{CC}) ? $theme->{CC} : 0; my $msg = "$query->{message}\n\n$theme->{sig}"; send_mail($to,$cc,"[CONTACT] $query->{subject}",$from,$from,$msg); print "<p><br>Your mail has been sent.<p>\n"; } sub mail_form { my ($query,$theme) = @_; my $from = verify($query,$theme); my $subject = $query->{subject}; $subject =~ s/"/"/g; my $message = $query->{message}; $message =~ s|</textarea|</textarea|g; # CC? my $CC=""; if ($theme->{CC}) { $CC = <<CC; <tr> <td>CC:</td> <td> <input type='checkbox' name='cc' checked value='yes'> <i>$theme->{CC}</i> </td> </tr> CC } print <<MAIL_FORM; <p> <form action='$URL' method='POST' name='mail_form'> <table> <tr> <td>From:</td> <td><i>$from</i></td> </tr> <tr> <td>To:</td> <td><i>$query->{n}</i></td> </tr> $CC <tr> <td>Subject:</td> <td><input type='text' name='subject' size='40' value="$subject"></td> </tr> <tr> <td>Message:</td> <td align='right'><input type='submit' name='handle_mail_form' value='Send'></td> </tr> <tr> <td colspan='2'> <input type='hidden' name='t' value='$query->{t}'> <input type='hidden' name='c' value='$query->{c}'> <input type='hidden' name='f' value='$query->{f}'> <input type='hidden' name='n' value='$query->{n}'> <textarea name='message' rows='10' cols='75' wrap='soft'>$message</textarea> </td> </tr> <tr> <td colspan='2' align='right'><input type='submit' name='handle_mail_form' value='Send'></td> </tr> </table> </form> MAIL_FORM } sub handle_get_email { my ($query,$theme) = @_; # Verify that we haven't been swindled! if ($theme->{Agree} && !$query->{agree}) { ERROR("You didn't check the agreement box!"); return get_email($query,$theme); } # Avoid long emails that can be used to figure out the key my $from = $query->{f}; $from =~ s/^\s+//; $from =~ s/\s+$//; my $fromurl = to_url($from); if ($from !~ /(\S+)\@\S+\.\S/) { ERROR("Bad email, try again"); return get_email($query,$theme); } if (length($1) > 40) { ERROR("Email login [$1] too long"); return get_email($query,$theme); } # Shortest email would be something like x@xx.xx (7 characters) if (length($from)<7) { ERROR("Email too short"); return get_email($query,$theme); } # Encrypt a check key with their email address # (Okay, so it's not perfect, but nothing will be without strong encryption..) my $c=lengthen($theme->{CheckKey},$from); my $check = to_url encrypt($from,$c); # my $un = decrypt($from,from_url $check); my $n = $query->{n} eq $DEFAULT_NAME ? "" : ("&n=".to_url $query->{n}); send_mail($from,0,"URL to contact $query->{n}",$from,$from,<<MESSAGE_URL); To finish contacting $query->{n}, go to the following URL: $URL?t=$query->{t}&f=$fromurl&c=$check$n [Make sure to paste in the *full* URL above!] $theme->{sig} MESSAGE_URL print <<SENT_URL <p> A URL has been sent to: $from <p> You should be receiving it shortly. <p> When you visit that URL, you will be able to compose a message to $query->{n} <p> SENT_URL } sub get_email { my ($query,$theme) = @_; my $agree = $theme->{Agree}; $agree = "<br>$agree <input type='checkbox' name='agree' value='yes'>\n" if $agree; my $who = $query->{n} eq $DEFAULT_NAME ? "this person" : $query->{n}; # Well, it's not perfect, but it'll catch some cases my $t=decrypt($theme->{key},$query->{t}); FATAL("Your URL was corrupted<br>Make sure you have the full, correct URL") if ($t !~ /\@.*\./); print <<GET_EMAIL; <p> To send email to $who, you need to give us your email address: <br> <font color='red' size='-1'>For "why?" see explanation below</font> <br> <form action='$URL' method='POST' name='get_email'> <input type='hidden' name='t' value='$query->{RAW}{t}'> <input type='hidden' name='n' value='$query->{n}'> Your email address: <input type='text' name='f' size='30' maxsize='200' value='$query->{f}'> <input type='submit' name='handle_get_email' value='Submit'> $agree </form> <p><hr><p> <a name='why'><i>Why?</i></a> <font size='-1'> <p> We're using this mailing system because: <ol> <li> We don't want to give out our email address <li> We don't want forged email </ol> The only solution for this is a simple two-step process. Here's how it works: <ol> <li> You clicked on a link to contact $query->{n}, and got to this page. <li> You enter your email address, and a second URL is emailed to you. You can use then use that URL to compose the email. </ol> If we don't take the second step, then we don't have anyway to verify your email, and we don't want to be doing that, now do we? </font> <p> GET_EMAIL } sub empty_form { my ($theme) = @_; FATAL("No query<p>\nyou need to link to this from another page",$theme); } ################################################## # Do it ################################################## sub main { if (@ARGV) { die("Usage: $0 <key> <text>\n") unless $#ARGV==1; print "Decrypt: ",decrypt(@ARGV),"\nEncrypt: ",encrypt(@ARGV),"\n"; exit; } my $theme = get_theme; my $query = parse_query(); $query->{n} = $query->{n} || $DEFAULT_NAME; if ($query->{handle_get_email}) { handle_get_email($query,$theme); } elsif ($query->{handle_mail_form}) { handle_mail_form($query,$theme); } elsif ($query->{f}) { mail_form($query,$theme); } elsif ($query->{t}) { get_email($query,$theme); } else { empty_form($theme); } footer($theme); # If we need did the default header } main();