#!/usr/bin/perl # # Redirect to a mailto: location. E-mail address in # QUERY_STRING will have $domain appended. # # Example: instead of mailto:foo@bar.com # use mailto.cgi?foo=bar.com # # $Id: mailto,v 1.2 1999/02/18 16:50:12 pallo Exp $ die "CGI environment error!\n" unless $ENV{SERVER_NAME} && $ENV{QUERY_STRING} && $ENV{HTTP_USER_AGENT} ; my $domain = $ENV{SERVER_NAME}; $domain =~ s/^[^\.]+\.((:?[\w-]+\.)+[a-zA-Z]{2,3})$/\@$1/; do { print "Content-type: text/plain\n\nError in configuration!\n". "($domain eq $ENV{SERVER_NAME})\n"; die "*** Error in $0!\n"; } if $domain eq $ENV{SERVER_NAME} && $domain !~ m/^[\w-]+\.[\w]{2,3}$/; my $address = $ENV{QUERY_STRING}; # Decode args $address =~ tr/+/ /; $address =~ s/%(..)/pack("c",hex($1))/ge; # Remove "evil" characters. $address =~ tr/\@\`\r\n\|\{\}\$//d; $address .= $domain; # Block clients in RBL and some agents with known names. if(&check_block) { print "Content-Type: text/html\n"; print "Status: 403 Forbidden\n\n"; print "

mailto: failed

\n"; print "

You do not have permission to access mailto-links.

"; exit 0; } # Everything is OK, redirect and print descriptive text print "Content-Type: text/html\n"; print "Status: 301 Moved permanently\n"; print "Location: mailto:".$address."\n\n"; print "\n"; print "\n"; print "mailto: failed\n"; print "\n\n"; print "

mailto: failed

\n"; print "

If you can read this your browser does not support\n"; print "redirection to mailto: links. You will have to cut and paste\n"; print "the address below into your e-mail program.

\n"; $address =~ s/\@/&\#64;/g; print "
\n".$address."\n
\n"; print ""; exit; ################################## SUBS ################################## # Check if this one should be blocked sub check_block { if(&check_is_bad_browser($ENV{HTTP_USER_AGENT})) { printf(STDERR "[%s] [info] /cgi-bin/mailto blocked '%s' from '%s': Bad browser\n", scalar(localtime), $ENV{HTTP_USER_AGENT}, $ENV{REMOTE_ADDR}); return 1; } if(&check_is_in_rbl($ENV{REMOTE_ADDR} || "127.0.0.1")) { printf(STDERR "[%s] [info] /cgi-bin/mailto blocked '%s' from '%s': In RBL\n", scalar(localtime), $ENV{HTTP_USER_AGENT}, $ENV{REMOTE_ADDR}); return 1; } return 0; } # Lookup address in RBL sub check_is_in_rbl { my($addr) = shift; $addr =~ s/([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})/$4.$3.$2.$1.rbl.maps.vix.com/; return 1 if( gethostbyname($addr) ); return 0; } # Check for bad browsers sub check_is_bad_browser { my($ua) = shift; return 1 if ($ua =~ /EmailSiphon/i); return 1 if ($ua =~ /ExtractorPro/i); return 1 if ($ua =~ /Crescent Internet ToolPak HTTP OLE Control/i); return 1 if ($ua =~ /NEWT ActiveX/i); return 1 if ($ua =~ /EmailWolf/i); return 1 if ($ua =~ /EmailCollector/i); return 1 if ($ua =~ /CherryPicker/i); return 1 if ($ua =~ /WebBandit/i); return 1 if ($ua =~ /NICErsPRO/i); return 1 if ($ua =~ /^Teleport/i); return 1 if ($ua =~ /^WebZip/i); return 1 if ($ua =~ /^WebVCR/i); return 1 if ($ua =~ /^LinkSweeper/i); return 0; }