head     1.14;
branch   ;
access   ;
symbols  ;
locks    ; strict;
comment  @# @;


1.14
date     95.03.09.13.25.13;  author yonah;  state Exp;
branches ;
next     1.13;

1.13
date     95.03.07.13.05.19;  author yonah;  state Exp;
branches ;
next     1.12;

1.12
date     94.12.02.14.57.48;  author root;  state Exp;
branches ;
next     1.11;

1.11
date     94.11.30.14.15.09;  author root;  state Exp;
branches ;
next     1.10;

1.10
date     94.11.07.15.34.44;  author mkgray;  state Exp;
branches ;
next     1.9;

1.9
date     94.11.07.15.12.37;  author mkgray;  state Exp;
branches ;
next     1.8;

1.8
date     94.10.31.08.06.34;  author mkgray;  state Exp;
branches ;
next     1.7;

1.7
date     94.09.21.18.34.53;  author rei;  state Exp;
branches ;
next     1.6;

1.6
date     94.09.20.05.21.02;  author rei;  state Exp;
branches ;
next     1.5;

1.5
date     94.09.20.05.04.10;  author rei;  state Exp;
branches ;
next     1.4;

1.4
date     94.09.19.23.05.18;  author nocturne;  state Exp;
branches ;
next     1.3;

1.3
date     94.08.11.20.49.25;  author nocturne;  state Exp;
branches ;
next     1.2;

1.2
date     94.07.21.18.38.20;  author nocturne;  state Exp;
branches ;
next     1.1;

1.1
date     94.07.21.18.23.51;  author nocturne;  state Exp;
branches ;
next     ;


desc
@our mail gateway. neato keen.
@


1.14
log
@added listserv to the "we don't do that" section
-yonah
@
text
@#!/usr/athena/bin/perl
# $Id: comment,v 1.13 95/03/07 13:05:19 yonah Exp Locker: yonah $

require 'ctime.pl';

print("Content-Type: text/html\n\n");

$query = join(' ', @@ARGV) if $ARGV[0];
&do_comment($query);

# package comment;

### main part: decide what we're doing...

sub do_comment {
    local($query) = @@_;
    $args =~ s/\+/ /g;

    if (&badformclient()) {
	  &loserclient();
	}
    else {
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
       	  read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	  &parse($query);
        } else {
	  if (! $ENV{'SERVER_PROTOCOL'}) {
	    &old($query);
	  }
	  else {
	    &form();
	  }
         }
    }
}

### generate a form to be filled out
#
#   for more info, see
#http://www.ncsa.uiuc.edu/SDG/Software/Mosaic/Docs/fill-out-forms/overview.html

sub form {
	$remuser = $ENV{'REMOTE_USER'};
    print <<"EndOfForm";
<title>Comments on WWW.MIT.EDU</title>
<h1>Comments on this server</h1>

Thank you for taking some time to comment on our server.  Just fill
out the form below, and click on the "Send..." button.  If you are not sure
who to send to, please send to webmaster@@mit.edu.<p>

If you wish to remain anonymous, leave the E-mail address field blank.
Just remember that we can't reply to you if you don't tell us who you
are :-)

Note: if you use our gateway to send email and it bounces, the bounced
email will go to the SIPB webmasters.

<hr>

<FORM method="POST">
Your E-mail address: <input name="email" value="$remuser" size=30><p>
Mail to: <select name="to">
	<option value="webmaster@@mit.edu" selected> webmaster@@mit.edu
	<option value="eichin@@mit.edu"> eichin@@mit.edu (Callsign Gateway)
	<option value="erichard@@mit.edu"> erichard@@mit.edu (Sports Server)
	<option value="mkgray@@mit.edu"> mkgray@@mit.edu (Web Wanderer and Weather Gateway)
	<option value="os2www@@mit.edu"> os2www@@mit.edu (OS/2 WWW page)
	<option value="sorokin@@mit.edu"> sorokin@@mit.edu (Women's resources)
	<option value="rei@@mit.edu"> rei@@mit.edu (art, "The WWW for Dummies", and anything else)

</select><p>
Subject or URL: <input name="url" size=40><p>
<TEXTAREA name="body" rows=9 cols=60></TEXTAREA><p>
<input type="submit" value="Send in the comment">
<input type="reset" value="Naaaaah, just kidding">
</FORM>
<hr>
<ul>
<li><a href="/">SIPB Home Page</a>
<li><a href="services/sis/sports.html">Eric Richard's Sports Server</a>
<li><a href="people/mkgray/web-growth.html">Matthew Gray's Web Wanderer</a>
<li><a href="activities/os2/os2world.html">OS/2 WWW Page</a>
<li><a href="people/sorokin/women/index.html">Jessie Stickgold-Sarah's Women's resources page</a>
</ul>
EndOfForm
}
# Removed:
#	<option value="harrisj@@mit.edu"> harrisj@@mit.edu (Testing this Script)
### remove \000-\039 and \177-\377

sub prot {
    @@_[0] =~ s/[\000-\037\177-\377]+//g;
    @@_[0];
}
### parsing comments
#
#   the comments are all packed in the form
#      field1=value1&field2=value2&...
#   with the "invalid" characters encoded as %-sequences.

sub parse {
    local(%post, *SM, $tmp, $name);
    local($nil) = 'Anonymous User <nobody>';
    local($sm) = '/usr/lib/sendmail -t -fwebmaster@@mit.edu';

    for (split(/&/,@@_[0])) {
	if (/=/) {
	    $name = $`;
	    $tmp = $';
	    $tmp =~ s/\+/ /g;
	    $tmp =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;
	    $post{$name} = $tmp;
	}
    }

    if (&prot($post{'to'}) =~ /listproc@@/i
     || &prot($post{'to'}) =~ /listserv@@/i) {
       print "<html><head><title>Request failed</title></head>\n<body>\n";
       print "<h1>Request failed</h1>\n";
       print "Sorry, our gateway does not handle listproc or listserv mail.\n\n";
       print "And even if it did, you couldn't subscribe yourself to a\n";
       print "listproc using it. You would end up subscribing\n";
       print "\"webmaster@@mit.edu\" to the listproc, which isn't likely to\n";
       print "be something you want. :-)\n</body></html>";
       exit;
    }

    open(SM, "|$sm");
    printf SM "From: %s\nSubject: comment -- %s\nTo: %s\n",
       ($post{'email'} =~ /\S/) ? &prot($post{'email'}) : $nil,
       &prot($post{'url'}),  $post{'to'};
    print SM "X-WebClient: $ENV{'HTTP_USER_AGENT'}\n";
    print SM $post{'body'},"\n";

#Reverse resolve the machine name from the IP address:

@@ipaddr = split(/\./, $ENV{'REMOTE_ADDR'});
$packipaddr = pack('C4', @@ipaddr);
$realname = (gethostbyaddr($packipaddr,2))[0];
unless ($realname)
{
    $realname = "could not reverse-resolve name"
}



    printf SM "\n-----\nsubmitted by '%s' on %s (%s)\nEmail sent via the WWW comment gateway at %s:%s.\n\nWarning: the sender's name and address may be forged.\n", $post{'email'}, $ENV{'REMOTE_ADDR'}, $realname, $ENV{'SERVER_NAME'}, $ENV{'SERVER_PORT'}

      if ($post{'email'} =~ /\S/);
    close(SM);

    if($ENV{'HTTP_REFERER'}){
	open(CREF, ">>/var/local/www/logs/comment_usage");
	print(CREF "$ENV{'HTTP_REFERER'}  ".&ctime(time));
	close(CREF);
}


    unless ($?) {
	print "<title>Submission Receipt</title>\n";
	if ($post{'to'} eq "webmaster@@mit.edu") {
           print "<h1>Thank you for your comments!</h1>\n";
           print "Please continue to let us know what you think is\n";
           print "particularly good or bad about our server.<p>\n";
	}
	else {
	   print "<h1>Your message has been sent!</h1>\n";
	}
        print "Comment as submitted:<p>\n<pre>\n";
	printf "Comment submitted to: %s\n", $post{'to'};
	printf "Your E-mail address: %s\n",
          ($post{'email'} =~ /\S/) ? &prot($post{'email'}) : "(anonymous)";
	printf "Subject:             %s\n\n", &prot($post{'url'});
	printf "Comment body:\n<hr>\n%s\n<hr></pre>\n", $post{'body'};
    } else {
	&main'report_error('internal_error', "sendmail failed with error $?");
    }
}

### compatibility with HTTP/0.9 and earlier
#   (just uses <isindex>)

sub old {
    local($args) = @@_;

    print <<"EndOfStuff";
<title>Comments on WWW.MIT.EDU</title>
<h1>Your client is old...</h1>

Your client does not support HTTP/1.0, and therefore can't use the
form support interface.<p>

Please enter your comments in the Search keyword field.<p>

<isindex>
EndOfStuff

    if($args){
	local($date) = &ctime(time); chop($date);
	print "Thanks for your comments!!!\n";
	open(COMM, ">>/var/local/www/comments") ||
	    &error('internal_error',"Can't open comments file!");
	print COMM $ENV{'REMOTE_ADDR'}." $date $args\n";
	close(COMM);
    }
}

sub badformclient {
  $_=$ENV{'HTTP_USER_AGENT'};
  if (/NCSA Mosaic [^\/]*\/2\.([0-9]+)/)
    {
	if ($1 < 2) { 
	  return 1;
	}
  }
  if (/MacMosaic/)
  {
    return 1;
  }

# Macweb foo example return string is "MacWeb/1.00ALPHA2.1
# 1.00ALPHA2.1 is okay.
  if (/MacWeb(\d*\.?\d*)[^\d]/) {
     $ver = $1;
     $rest = $';
     if ($ver < 2) {
        $rest =~ /ALPHA(\d*\.\d*)[^\d]/;
	$alpha_ver = $1;
	if ($alpha_ver >= 2.1) {
	   return 0;
        } else {
           return 1;
        }
     } else {
        return 0;
     }
  }
  return 0;
}

sub loserclient {
    print <<"EndOfStuff";
<TITLE>Incompatible Client Warning</TITLE>

<h1>Incompatible Client Warning</h1>

I'm sorry, but your web browsing client is incompatible with this
comment script. It might be a good idea to contact your site
administrator to see if there is a more recent version of your client
program.<P>

To be more specific, your web browser must support the <b>value</b>
tag in Forms to be compatible with this script.  Otherwise, your mail
will bounce. Known incompatible client software is:

<UL>
<LI>Mosaic for X, version 2.1 and earlier
<LI>Mac Mosaic, version 2alpha6 and earlier
<LI>MacWeb, version 1.00ALPHA2 and earlier
</UL>

If your client does support the <B>value</b> tag, and we have
erroneously filtered you out, send mail to webmaster@@mit.edu, telling
us your client and version number so we can check it out. Thank
you.<P>

EndOfStuff

}

1;
@


1.13
log
@changed to local perl
@
text
@d2 1
a2 1
# $Id: comment,v 1.12 94/12/02 14:57:48 root Exp Locker: yonah $
d117 2
a118 1
    if (&prot($post{'to'}) =~ /listproc@@/) {
d121 1
a121 1
       print "Sorry, our gateway does not handle listproc mail.\n\n";
@


1.12
log
@added support for macweb comment stuff, some.
@
text
@d1 2
a2 2
#!/afs/athena/contrib/perl/p
# $Id: comment,v 1.11 94/11/30 14:15:09 root Exp Locker: root $
@


1.11
log
@added listproc refusal code. (nocturne)
@
text
@d2 1
a2 1
# $Id: comment,v 1.10 94/11/07 15:34:44 mkgray Exp Locker: root $
d220 17
a236 3
  if (/MacWeb/)
  {
    return 1;
@


1.10
log
@fixed a typo
@
text
@d2 1
a2 1
# $Id: comment,v 1.9 94/11/07 15:12:37 mkgray Exp Locker: mkgray $
d115 11
@


1.9
log
@Added code to record referer field so
we can see to what extent the gateway is being used
@
text
@d2 1
a2 1
# $Id: comment,v 1.8 94/10/31 08:06:34 mkgray Exp Locker: mkgray $
d143 1
a143 2
	print(CREF "$ENV{'HTTP_REFERER'}  ".&ctime(time);
	print CREF "\n";
@


1.8
log
@Autodetects the username of the person, if it gets sent
@
text
@d2 1
a2 1
# $Id: comment,v 1.7 94/09/21 18:34:53 rei Exp Locker: mkgray $
d140 8
@


1.7
log
@added note
@
text
@d2 1
a2 1
# $Id: comment,v 1.6 1994/09/20 05:21:02 rei Exp rei $
d43 1
d62 1
a62 1
Your E-mail address: <input name="email" size=30><p>
@


1.6
log
@*** empty log message ***
@
text
@d2 1
a2 1
# $Id: comment,v 1.5 1994/09/20 05:04:10 rei Exp rei $
d54 3
@


1.5
log
@added warning and also reverse-resolve IP address
@
text
@d2 1
a2 1
# $Id: comment,v 1.4 1994/09/19 23:05:18 nocturne Exp rei $
d52 2
d66 1
a66 1
	<option value="rei@@mit.edu"> rei@@mit.edu (art, "The WWW for Dummies", and also for testing)
d127 1
a127 1
    $realname = "could not resolve name"
d132 1
a132 1
    printf SM "\n-----\nsubmitted by '%s' on %s (%s)\nEmail sent via the comment gateway at %s.\n\nWarning: the sender's name and address may be forged.\n", $post{'email'}, $ENV{'REMOTE_ADDR'}, $realname, $ENV{'SERVER_NAME'}
@


1.4
log
@dunno what changed
@
text
@d2 1
a2 1
# $Id: comment,v 1.3 1994/08/11 20:49:25 nocturne Exp nocturne $
d59 1
d61 1
a61 1
	<option value="mkgray@@mit.edu"> mkgray@@mit.edu (Web Wanderer)
d64 2
a65 1
	<option value="harrisj@@mit.edu"> harrisj@@mit.edu (Testing this Script)
d82 2
a83 1

d117 15
a131 1
    printf SM "\n(submitted by %s on %s)\n", $post{'email'}, $ENV{'REMOTE_ADDR'}
@


1.3
log
@this is the version jake left sitting around.
I don't know what all he did.
@
text
@d2 1
a2 1
# $Id: barbarbar,v 1.1 1994/08/11 20:47:56 nocturne Exp $
d19 2
a20 2
    if (do badformclient()) {
	  do loserclient();
d25 1
a25 1
	  do parse($query);
d28 1
a28 1
	    do old($query);
d31 1
a31 1
	    do form();
a42 2
    # local($url) = $main'plexus{'server'}.'/'.@@_[0];

d94 1
a94 2
    local(%post, *SM);
    local($tmp,$name);
@


1.2
log
@added code so reply message makes sense when it's not to webmaster
@
text
@d2 1
a2 1
# $Id: comment,v 1.1 1994/07/21 18:23:51 nocturne Exp nocturne $
d19 9
a27 5
    if ($ENV{'REQUEST_METHOD'} eq "POST") {
	read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
	do parse($query);
    } else {
	if (! $ENV{'SERVER_PROTOCOL'}) {
d29 2
a30 1
	} else {
d32 2
a33 1
	}
d65 1
a88 1

d112 1
a112 1
    printf SM "From: %s\nSubject: comment -- %s\nTo: %s\n\n",
d115 1
d168 49
@


1.1
log
@Initial revision
@
text
@d2 1
a2 1
# $Id: comment.pl,v 1.7 1994/04/29 01:49:27 mkgray Exp $
d116 8
a123 3
        print "<h1>Thank you for your comments!</h1>\n";
        print "Please continue to let us know what you think is\n";
        print "particularly good or bad about our server.<p>\n";
@
