[alt.sources] Anonymous Contact Service software v1.1, Part07/08

csu@alembic.acs.com (Dave Mack) (07/16/90)

This is the second distribution of the Anonymous Contact Service
software. The distribution consists of 8 shar files. This will
(hopefully) be the last full distribution of the system - all
future versions will be distributed as patches. The patchlevel of
this version is 1.

The ACS software provides a mechanism for posting anonymous articles,
for receiving replies to those articles which are also anonymous, and
permits prolonged anonymous conversations in which neither writer knows
the other's actual e-mail address.

This software is currently being used to provide an anonymous personals
service in alt.personals.

Dave Mack
csu@alembic.ACS.COM

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 7 (of 8)."
# Contents:  mailer/deliver.c unspool
# Wrapped by csu@alembic on Sun Jul 15 12:46:54 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'mailer/deliver.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'mailer/deliver.c'\"
else
echo shar: Extracting \"'mailer/deliver.c'\" \(12633 characters\)
sed "s/^X//" >'mailer/deliver.c' <<'END_OF_FILE'
X/*
X**  Deliver.c
X**
X**  Routines to effect delivery of mail for rmail/smail. 
X**
X*/
X
X#ifndef lint
Xstatic char 	*sccsid="@(#)deliver.c	2.5 (smail) 9/15/87";
X#endif
X
X# include	<stdio.h>
X# include	<sys/types.h>
X# include	<sys/stat.h>
X# include	<ctype.h>
X# include	<signal.h>
X# include	"defs.h"
X
Xextern int  exitstat;		/* set if a forked mailer fails */
Xextern enum edebug debug;	/* how verbose we are 		*/ 
Xextern char hostname[];		/* our uucp hostname 		*/
Xextern char hostdomain[];	/* our host's domain 		*/
Xextern enum ehandle handle;	/* what we handle		*/
Xextern enum erouting routing;	/* how we're routing addresses  */
Xextern char *uuxargs;		/* arguments given to uux       */
Xextern int  queuecost;		/* threshold for queueing mail  */
Xextern int  maxnoqueue;		/* max number of uucico's       */
Xextern char *spoolfile;		/* file name of spooled message */
Xextern FILE *spoolfp;		/* file ptr  to spooled message */
Xextern int spoolmaster;		/* set if creator of spoolfile  */
Xextern char nows[];		/* local time in ctime(3) format*/
Xextern char arpanows[];		/* local time in arpadate format*/
Xchar stderrfile[20];		/* error file for stderr traping*/
X#ifdef ACSMAIL
Xextern char *from_addr;		/* From: line contents */
X#endif
X/*
X**
X**  deliver():  hand the letter to the proper mail programs.
X**
X**  Issues one command for each different host of <hostv>,
X**  constructing the proper command for LOCAL or UUCP mail.
X**  Note that LOCAL mail has blank host names.
X**
X**  The <userv> names for each host are arguments to the command.
X** 
X**  Prepends a "From" line to the letter just before going 
X**  out, with a "remote from <hostname>" if it is a UUCP letter.
X**
X*/
X
Xdeliver(argc, hostv, userv, formv, costv)
Xint argc;				/* number of addresses		*/
Xchar *hostv[];				/* host names			*/
Xchar *userv[];				/* user names			*/
Xenum eform formv[];			/* form for each address	*/
Xint costv[];				/* cost vector 			*/
X{
X	FILE *out;			/* pipe to mailer		*/
X	FILE *popen();			/* to fork a mailer 		*/
X#ifdef RECORD
X	void record();			/* record all transactions	*/
X#endif
X#ifdef LOG
X	void log();
X#endif
X	char *mktemp();
X	char from[SMLBUF];		/* accumulated from argument 	*/
X	char lcommand[SMLBUF];		/* local command issued 	*/
X	char rcommand[SMLBUF];		/* remote command issued	*/
X	char scommand[SMLBUF];		/* retry  command issued	*/
X	char *command;			/* actual command		*/
X	char buf[SMLBUF];		/* copying rest of the letter   */
X	enum eform form;		/* holds form[i] for speed 	*/
X	long size;			/* number of bytes of message 	*/
X	char *flags;			/* flags for uux		*/
X	char *sflag;			/* flag  for smail		*/
X	int i, j, status, retrying;
X	char *c, *postmaster();
X	int failcount = 0;
X	int noqcnt = 0;			/* number of uucico's started   */
X	char *uux_noqueue = UUX_NOQUEUE;/* uucico starts immediately    */
X	char *uux_queue   = UUX_QUEUE;	/* uucico job gets queued       */
X	off_t message;
X	struct stat st;
X
X#ifdef ACSMAIL
X	char acs_user[SMLBUF];
X	char *atsign;
X	strcpy(acs_user,from_addr);
X	atsign = index(acs_user,'@');
X	if (atsign) *atsign = '\000';
X/*	fprintf(stderr,"from_addr = %s, acs_user = %s\n",from_addr,acs_user);*/
X#endif
X/*
X** rewind the spool file and read the collapsed From_ line
X*/
X	(void) fseek(spoolfp, 0L, 0);
X	(void) fgets(from, sizeof(from), spoolfp);
X#ifdef ACSMAIL
X	strcpy(from,acs_user);
X#endif
X	if((c = index(from, '\n')) != 0) *c = '\0';
X	message = ftell(spoolfp);
X
X/*
X**  We pass through the list of addresses.
X*/
X	stderrfile[0] = '\0';
X	for(i = 0; i < argc; i++) {
X		char *lend = lcommand;
X		char *rend = rcommand;
X		char *send = scommand;
X
X/*
X**  If we don't have sendmail, arrange to trap standard error
X**  for inclusion in the message that is returned with failed mail.
X*/
X		(void) unlink(stderrfile);
X		(void) strcpy(stderrfile, "/tmp/stderrXXXXXX");
X		(void) mktemp(stderrfile);
X		(void) freopen(stderrfile, "w", stderr);
X		if(debug != YES) {
X			(void) freopen(stderrfile, "w", stdout);
X		}
X
X		*lend = *rend = *send = '\0';
X
X/*
X**  If form == ERROR, the address was bad 
X**  If form == SENT, it has been sent on a  previous pass.
X*/
X		form = formv[i];
X		if (form == SENT) {
X			continue;
X		}
X/*
X**  Build the command based on whether this is local mail or uucp mail.
X**  By default, don't allow more than 'maxnoqueue' uucico commands to
X**  be started by a single invocation of 'smail'.
X*/
X		if(uuxargs == NULL) {	/* flags not set on command line */
X			if(noqcnt < maxnoqueue && costv[i] <= queuecost) {
X				flags = uux_noqueue;
X			} else {
X				flags = uux_queue;
X			}
X		} else {
X			flags = uuxargs;
X		}
X
X		retrying = 0;
X		if(routing == JUSTDOMAIN) {
X			sflag = "-r";
X		} else if(routing == ALWAYS) {
X			sflag = "-R";
X		} else {
X			sflag = "";
X		}
X
X		(void) sprintf(lcommand, LMAIL(from, hostv[i]));
X		(void) sprintf(rcommand, RMAIL(flags, from, hostv[i]));
X
X/*
X**  For each address with the same host name and form, append the user
X**  name to the command line, and set form = ERROR so we skip this address
X**  on later passes. 
X*/
X		/* we initialized lend (rend) to point at the
X		 * beginning of its buffer, so that at
X		 * least one address will be used regardless
X		 * of the length of lcommand (rcommand).
X		 */
X		for (j = i; j < argc; j++) {
X			if ((formv[j] != form)
X			 || (strcmpic(hostv[i], hostv[j]) != 0)
X			 || ((lend - lcommand) > MAXCLEN)
X			 || ((rend - rcommand) > MAXCLEN)) {
X				continue;
X			}
X
X			/*
X			** seek to the end of scommand
X			** and add on a 'smail' command
X			** multiple commands are separated by ';'
X			*/
X
X			send += strlen(send);
X			if(send != scommand) {
X				*send++ = ';' ;
X			}
X
X			(void) sprintf(send, RETRY(sflag));
X			send += strlen(send);
X
X			lend += strlen(lend);
X			rend += strlen(rend);
X
X			if (form == LOCAL) {
X				(void) sprintf(lend, LARG(userv[j]));
X				(void) sprintf(send, LARG(userv[j]));
X			} else {
X				(void) sprintf(lend, RLARG(hostv[i], userv[j]));
X				(void) sprintf(send, RLARG(hostv[i], userv[j]));
X			}
X
X			(void) sprintf(rend, RARG(userv[j]));
X			formv[j] = SENT;
X		}
Xretry:
X/*
X** rewind the spool file and read the collapsed From_ line
X*/
X		(void) fseek(spoolfp, message, 0);
X
X		/* if the address was in a bogus form (usually DOMAIN),
X		** then don't bother trying the uux.
X		**
X		** Rather, go straight to the next smail routing level.
X		*/
X		if(form == ERROR) {
X			static char errbuf[SMLBUF];
X			(void) sprintf(errbuf,
X				"address resolution ('%s' @ '%s') failed",
X					userv[i], hostv[i]);
X			command = errbuf;
X			size    = 0;
X			goto form_error;
X		}
X
X		if (retrying) {
X			command = scommand;
X		} else if (form == LOCAL) {
X			command = lcommand;
X		} else {
X			command = rcommand;
X			if(flags == uux_noqueue) {
X				noqcnt++;
X			}
X		}
X		ADVISE("COMMAND: %s\n", command);
X
X/*
X** Fork the mailer and set it up for writing so we can send the mail to it,
X** or for debugging divert the output to stdout.
X*/
X
X/*
X** We may try to write on a broken pipe, if the uux'd host
X** is unknown to us.  Ignore this signal, since we can use the
X** return value of the pclose() as our indication of failure.
X*/
X		(void) signal(SIGPIPE, SIG_IGN);
X
X		if (debug == YES) {
X			out = stdout;
X		} else {
X			failcount = 0;
X			do {
X				out = popen(command, "w");
X				if (out) break;
X				/*
X				 * Fork failed.  System probably overloaded.
X				 * Wait awhile and try again 10 times.
X				 * If it keeps failing, probably some
X				 * other problem, like no uux or smail.
X				 */
X				(void) sleep(60);
X			} while (++failcount < 10);
X		}
X		if(out == NULL) {
X			exitstat = EX_UNAVAILABLE;
X			(void) printf("couldn't execute %s.\n", command);
X			continue;
X		}
X
X		size = 0;
X		if(fstat(fileno(spoolfp), &st) >= 0) {
X			size = st.st_size - message;
X		}
X/*
X**  Output our From_ line.
X*/
X		if (form == LOCAL) {
X#ifdef SENDMAIL
X#ifdef ACSMAIL
X			(void) sprintf(buf, LFROM(acs_user, nows, hostname));
X#else
X			(void) sprintf(buf, LFROM(from, nows, hostname));
X#endif /* ACSMAIL */
X			size += strlen(buf);
X			(void) fputs(buf, out);
X#else
X			char *p;
X			if((p=index(from, '!')) == NULL) {
X				(void) sprintf(buf,
X#ifdef ACSMAIL
X					LFROM(acs_user, nows, hostname));
X#else
X					LFROM(from, nows, hostname));
X#endif /* ACSMAIL */
X				size += strlen(buf);
X				(void) fputs(buf, out);
X			} else {
X				*p = NULL;
X#ifdef ACSMAIL
X				(void) sprintf(buf, RFROM(acs_user, nows, from));
X#else
X				(void) sprintf(buf, RFROM(p+1, nows, from));
X#endif
X				size += strlen(buf);
X				(void) fputs(buf, out);
X				*p = '!';
X			}
X#endif
X		} else {
X#ifdef ACSMAIL
X			(void) sprintf(buf, RFROM(acs_user, nows, hostname));
X#else
X			(void) sprintf(buf, RFROM(from, nows, hostname));
X#endif
X			size += strlen(buf);
X			(void) fputs(buf, out);
X		}
X
X#ifdef SENDMAIL
X/*
X**  If using sendmail, insert a Received: line only for mail
X**  that is being passed to uux.  If not using sendmail, always
X**  insert the received line, since sendmail isn't there to do it.
X*/
X		if(command == rcommand && handle != ALL)
X#endif
X		{
X			(void) sprintf(buf,
X				"Received: by %s (%s)\n\tid AA%05d; %s\n",
X					hostdomain, VERSION,
X					getpid(), arpanows);
X			size += strlen(buf);
X			(void) fputs(buf, out);
X		}
X
X/*
X**  Copy input.
X*/
X		while(fgets(buf, sizeof(buf), spoolfp) != NULL) {
X			(void) fputs(buf, out);
X		}
X/*
X**  Get exit status and if non-zero, set global exitstat so when we exit
X**  we can indicate an error.
X*/
Xform_error:
X		if (debug != YES) {
X			if(form == ERROR) {
X				exitstat = EX_NOHOST;
X			} else if (status = pclose(out)) {
X				exitstat = status >> 8;
X			}
X			/*
X			 * The 'retrying' check prevents a smail loop.
X			 */
X			if(exitstat != 0) {
X				/*
X				** the mail failed, probably because the host
X				** being uux'ed isn't in L.sys or local user
X				** is unknown.
X				*/
X
X				if((retrying == 0)	/* first pass */
X				&& (routing != REROUTE)	/* have higher level */
X				&& (form != LOCAL)) {	/* can't route local */
X					/*
X					** Try again using a higher
X					** level of routing.
X					*/
X					ADVISE("%s failed (%d)\ntrying %s\n",
X						command, exitstat, scommand);
X					exitstat = 0;
X					retrying = 1;
X					form = SENT;
X					goto retry;
X				}
X
X				/*
X				** if we have no other routing possibilities
X				** see that the mail is returned to sender.
X				*/
X
X				if((routing == REROUTE)
X			        || (form == LOCAL)) {
X
X					/*
X					** if this was our last chance,
X					** return the mail to the sender.
X					*/
X
X					ADVISE("%s failed (%d)\n",
X						command, exitstat);
X					
X					(void) fseek(spoolfp, message, 0);
X#ifdef SENDMAIL
X					/* if we have sendmail, then it
X					** was handed the mail, which failed.
X					** sendmail returns the failed mail
X					** for us, so we need not do it again.
X					*/
X					if(form != LOCAL)
X#endif
X					{
X						return_mail(from, command);
X					}
X					exitstat = 0;
X				}
X			}
X# ifdef LOG
X			else {
X				if(retrying == 0) log(command, from, size); /* */
X			}
X# endif
X		}
X	}
X/*
X**  Update logs and records.
X*/
X# ifdef RECORD
X	(void) fseek(spoolfp, message, 0);
X	record(command, from, size);
X# endif
X
X/*
X**  close spool file pointer.
X**  if we created it, then unlink file.
X*/
X	(void) fclose(spoolfp);
X	if(spoolmaster) {
X		(void) unlink(spoolfile);
X	}
X	(void) unlink(stderrfile);
X}
X
X/*
X** return mail to sender, as determined by From_ line.
X*/
Xreturn_mail(from, fcommand)
Xchar *from, *fcommand;
X{
X	char buf[SMLBUF];
X	char domain[SMLBUF], user[SMLBUF];
X	char *r;
X	FILE *fp, *out, *popen();
X	int i = 0;
X
X	r = buf;
X
X	(void) sprintf(r, "%s %s", SMAIL, VFLAG);
X	r += strlen(r);
X
X	if(islocal(from, domain, user)) {
X		(void) sprintf(r, LARG(user));
X	} else {
X		(void) sprintf(r, RLARG(domain, user));
X	}
X
X	i = 0;
X	do {
X		out = popen(buf, "w");
X		if (out) break;
X		/*
X		 * Fork failed.  System probably overloaded.
X		 * Wait awhile and try again 10 times.
X		 * If it keeps failing, probably some
X		 * other problem, like no uux or smail.
X		 */
X		(void) sleep(60);
X	} while (++i < 10);
X
X	if(out == NULL) {
X		(void) printf("couldn't execute %s.\n", buf);
X		return;
X	}
X
X	(void) fprintf(out, "Date: %s\n", arpanows);
X	(void) fprintf(out, "From: MAILER-DAEMON@%s\n", hostdomain);
X	(void) fprintf(out, "Subject: failed mail\n");
X	(void) fprintf(out, "To: %s\n", from);
X	(void) fprintf(out, "\n");
X	(void) fprintf(out, "=======     command failed      =======\n\n");
X	(void) fprintf(out, " COMMAND: %s\n\n", fcommand);
X
X	(void) fprintf(out, "======= standard error follows  =======\n");
X	(void) fflush(stderr);
X	if((fp = fopen(stderrfile, "r")) != NULL) {
X		while(fgets(buf, sizeof(buf), fp) != NULL) {
X			(void) fputs(buf, out);
X		}
X	}
X	(void) fclose(fp);
X	(void) fprintf(out, "======= text of message follows =======\n");
X/*
X**  Copy input.
X*/
X	(void) fprintf(out, "From %s\n", from);
X	while(fgets(buf, sizeof(buf), spoolfp) != NULL) {
X		(void) fputs(buf, out);
X	}
X	(void) pclose(out);
X}
END_OF_FILE
if test 12633 -ne `wc -c <'mailer/deliver.c'`; then
    echo shar: \"'mailer/deliver.c'\" unpacked with wrong size!
fi
# end of 'mailer/deliver.c'
fi
if test -f 'unspool' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'unspool'\"
else
echo shar: Extracting \"'unspool'\" \(13090 characters\)
sed "s/^X//" >'unspool' <<'END_OF_FILE'
X#! /usr/local/bin/perl
X#
X# unspool does all of the actual processing for the ACS.
X#
X#die "unspool.perl compiled successfully\n";
X#
X# If the lock file exists, we are already running. Die immediately.
Xif ( -e "/usr/personals/LCK..SPOOL" ) {
X	exit 0;
X}
X#
X# set up the environment for suid operations - no longer needed but...
X#
X$ENV{"PATH"} = "/bin:/usr/bin:/usr/local/bin:/usr/ucb:/usr/personals";
X$ENV{"IFS"} = '' if $ENV{"IFS"} ne '';
X$path = $ENV{"PATH"};
X
X# set the permissions on all files we create to user only.
Xumask(0077);
X
X# flush on selected channel
X$| = 1;
X#
X# create the lock file
X#
Xopen(LCK,">/usr/personals/LCK..SPOOL");
Xclose(LCK);
X
X# open the address:alias database
Xif (! dbmopen(r2a,"/usr/personals/real2alias",0600)) {
X	print STDERR ":::can't dbmopen real2alias: $!\n";
X	exit(1);
X}
X
X# open the alias-index file and get the current alias.
Xif (open(INDEX,'</usr/personals/alias-index')) {
X	$alias_index = <INDEX>;
X	close(INDEX);
X}
Xelse {
X	$alias_index = 'a';
X}
X#
X# Process all the replies in the spool directory
X#
X$seq = $$;
Xwhile (</usr/personals/spool/REP*> ) {
X	$repfile = $_;
X
X	# check to make sure no fast connections are running. unspool
X	# kicks off quite a few other processes, which can seriously
X	# degrade throughput on a fast modem connected to a slow system.
X	&fstchk;
X
X	# open the spooled reply file
X	open(MSG,"<$repfile");
X
X	# read the first line of the message, which contains the recipient's
X	# alias.
X	$target_alias = <MSG>;
X
X	# hack off the terminal newline
X	chop $target_alias;
X
X	# Load the message on MSG into an array
X	@message = <MSG> ;
X	close(MSG);
X
X	# open the file in the repair directory to store the header and
X	# status info in case something goes wrong.
X	$replog = 0;
X	$repname = "/usr/personals/repair/REP$seq-$target_alias";
X	if ( open(REPLOG,">$repname")) {
X		$replog = 1;
X		$seq++;
X	}
X
X	# get the sender's address from the From: line
X	$address = &getaddr;
X
X	# write the header and the extracted address to the repair file
X	print REPLOG @header if ( $replog );
X	print REPLOG "::: address = $address\n" if ( $replog );
X
X	# if we didn't get a usable address, go on to the next message
X	goto repfail if ( "$address" eq '' );
X
X	# extract the username from the address
X	$user = &getuser($address);
X
X	# log it in the repair file
X	print REPLOG "::: user = $user\n" if ( $replog );
X
X	# if there is none, or if it's not acceptable, go to next message
X	goto repfail if ( "$user" eq '' );
X
X	# extract the subject from the Subject: line
X	$subject = &getsubj;
X
X	# if the subject is empty, replace it with something clever
X	$subject = "(None)" if ( "$subject" eq '' );
X	# and log it
X	print REPLOG "::: subject = $subject\n" if ( $replog );
X
X	# look up the sender's alias in the database. If s/he doesn't
X	# have one, give hir one, and log it
X	$sender_alias = &getsender($address);
X	print REPLOG "::: sender_alias = $sender_alias\n" if ( $replog );
X
X	# Lookup target_alias in real2alias db
X	# WARNING: you cannot save time by jumping out of this loop
X	# after the target_alias has been found. Perl's implementation
X	# of the dbm stuff requires that "each" visit every entry in 
X	# the data base before it resets. This was the origin of the
X	# infamous reply to the wrong alias bug.
X	$recip_address = '';
X	$found = 0;
X	while (($key,$value) = each %r2a) {
X		if ( $found == 0 ) {
X			if ( "$value" eq "$target_alias" ) {
X				$recip_address = $key;
X				$found = 1;
X			}
X		}
X	}
X
X	# non-existent target alias - send a terse message to the sender
X	# explaining this.
X	if ( "$recip_address" eq '' ) {
X		# send a bounce message to sender
X		# Using elm here is a horrendous kluge. We should probably
X		# use smail instead.
X		open(ELM,"|/usr/local/bin/elm -s \"ACS Reply to $target_alias Failed\" $address");
X		print ELM "Alias $target_alias not found in database.\nSorry.\nACS\n";
X		close(ELM);
X		# log the failure
X		if ( $replog ) {
X			print REPLOG "::: No recip_address for $target_alias\n";
X		}
X		goto repfail;
X	}
X
X	# open a pipe into acsmail to send out the anonymous reply
X	if (! open(REPLY,"|/usr/personals/acsmail -F $sender_alias@alembic.ACS.COM $recip_address")) {
X		goto repfail;
X	}
X
X	# write the reply into acsmail's stdin. acsmail will add the other
X	# header fields.
X	print REPLY "Subject: $subject\n";
X	print REPLY "To: $recip_address\n\n";
X	print REPLY @body;
X	close(REPLY);
X
X	# since the reply apparently succeeded, unlink the repair file.
X	unlink($repname);
X	next;
X	# something broke. Note it in the repair file and do the next one.
Xrepfail:
X	print REPLOG "::: Reply failed\n" if ( $replog );
X	next;
X} continue {
X	# if a repair file is open, close it
X	close(REPLOG) if ( $replog );
X	# and delete the spooled reply file.
X	unlink($repfile);
X}
X#
X# Now do the messages to be posted
X#
Xwhile (</usr/personals/spool/POST*> ) {
X	$postfile = $_;
X
X	# check for other things that shouldn't be disturbed
X	&fstchk;
X
X	# open the spooled POST file
X	open(MSG,"<$postfile");
X
X	# Load the message on MSG into an array
X	@message = <MSG> ;
X	close(MSG);
X
X	# get the sender's address from the From: line
X	$address = &getaddr;
X	# if it's empty, forget it and do the next message
X	goto postfail if ( "$address" eq '' );
X
X	# get the username from the address
X	$user = &getuser($address);
X
X	# if the username is empty or forbidden, do the next message
X	goto postfail if ( "$user" eq '' );
X
X	# get the subject from the Subject: line
X	$subject = &getsubj;
X
X	# trash postings with "test" in the Subject: line
X	next if ( $subject =~ /test/io );
X
X	# if there is no subject, insert one
X	$subject = "(None)" if ( $subject eq '' );
X
X	# get the sender's alias. assign one if necessary.
X	$alias = &getsender($address);
X
X	# open a pipe into inews for the article
X	if ( ! open(INEWS,"| /bin/inews -h")) {
X		print STDERR "Can\'t pipe into inews\n";
X		goto postfail;
X	}
X
X	# write the article into inews' stdin
X	print INEWS "Path: $alias\n";
X	print INEWS "From: ",$alias,"@alembic.ACS.COM\n";
X	print INEWS "Newsgroups: alt.personals\n";
X	print INEWS "Subject: $subject\n";
X	print INEWS "Distribution: local\n";
X	print INEWS "Reply-To: ",$alias,"@alembic.ACS.COM\n";
X	print INEWS "Followup-To: sender\n";
X	print INEWS "Organization: Anonymous Contact Service\n";
X	print INEWS "\n";
X	print INEWS @body;
X
X	# add the ACS usage "signature"
X	print INEWS "\n-- \n";
X	print INEWS <<EOS;
XTo use this service, send email to:                   | There is a 25 line
XAnonymous posting:	acs-post@alembic.ACS.COM      | limit on all posts
XAnonymous reply:	<user's alias>@alembic.ACS.COM| and e-mail messages.
XTest path/get an alias: acs-ping@alembic.ACS.COM      | Alternate path:
XACS administrator:	acs-admin@alembic.ACS.COM     | uunet!alembic!...
XEOS
X	close(INEWS);
Xpostfail:
X	next;
X} continue {
X	# delete the spooled POST file
X	unlink($postfile);
X}
X
X#
X# Process the acs-ping messages
X#
Xwhile (</usr/personals/spool/PING*> ) {
X	$pingfile = $_;
X
X	# don't disturb high-priority processing
X	&fstchk;
X
X	# open the spooled PING file
X	open(MSG,"<$pingfile");
X
X	# Load the message on MSG into an array
X	@message = <MSG> ;
X	close(MSG);
X
X	# get the sender's address from the From: line
X	$address = &getaddr;
X
X	# forget it and do the next one if no address
X	goto pingfail if ( "$address" eq '' );
X
X	# extract the username from the address
X	$user = &getuser($address);
X
X	# skip to next message if the username is empty or forbidden
X	goto pingfail if ( "$user" eq '' );
X
X	# get the sender's alias, assigning one if necessary
X	$sender_alias = &getsender($address);	
X	$| = 1;
X
X	# open a pipe into smail to send the echo back
X	open(REPLY,"|smail -F acs-ping@alembic.ACS.COM $address")
X			|| die "Can't pipe into smail\n";
X
X	# write the ping message into smail's stdin
X	print REPLY "Subject: Message RCVD\n";
X	print REPLY "To: $address\n\n";
X	print REPLY "Your ping request has been received by acs-ping@alembic.ACS.COM\n";
X	print REPLY "Your alias will be $sender_alias@alembic.ACS.COM\n";
X	print REPLY "The header of your message as it arrived here follows:\n\n";
X
X	# send them a copy of their message header. Who knows why?
X	print REPLY @header;
X	close(REPLY);
Xpingfail:
X	next;
X} continue {
X	# delete the spooled PING file
X	unlink($pingfile);
X}
X
X# cleanup: close the real2alias database, delete the lock file, delete
X# and rewrite the alias-index file, and exit.
Xdbmclose(r2a);
Xunlink("/usr/personals/LCK..SPOOL");
Xunlink('/usr/personals/alias-index');
Xopen(INDEX,'>/usr/personals/alias-index') ||
X	die "Can't open alias-index: $!\n";
Xprint INDEX $alias_index;
Xclose(INDEX);
Xexit(0);
X
X# subroutine fstchk checks to see if there are any conditions on the
X# system which unspool would interfere with. Mostly, this consists of
X# high-speed data transfers and high-priority processes running. If
X# fstchk finds such a condition, it sleeps for 30 seconds, then checks
X# again to see if the condition still exists. It continues this loop
X# forever.
Xsub fstchk {
X	#
X	# If we're using a high-speed line, sleep until the call ends
X	# (otherwise the transfer rate drops through the floor)
X	#
X	while ( -e "/usr/spool/uucp/LCK/LCK..uunet" ) {
X		sleep 30;
X	}
X} # end subroutine fstchk
X
X#
X# Subroutine getaddr splits the message in global array @message
X# into global arrays @header and @body, truncates @body to 25
X# lines, tries to find a signature in @body and deletes it if it
X# finds one, the searches @header for a From: line and extracts
X# the actual address from it if it can.
X# Returns $address.
X#
Xsub getaddr {
X	#
X	# split the message into body and header
Xhb:	for ( $line = 0 ; $line <= $#message; $line++ ) {
X		if ( $message[$line] eq "\n" ) {
X			# store the header
X			@header = @message[ 0 .. $line-1 ];
X			# store the first 25 lines of the body
X			@body = @message [ $line+1 .. $line+25 ];
X			last hb;
X		}
X	}
X	#
X	# Trash the signature if present 
Xsig:	for ($line = 0; $line <= $#body; $line++ ) {
X		if ( $body[$line] eq "-- \n" || $body[$line] =~ /---/ ) {
X			$#body = $line - 1;
X			last sig;
X		}
X	}
X	#
X	# Get From: line from header
X	$from = '';
Xfrom:	for ($line = 0; $line <= $#header; $line++ ) {
X		if ( $header[$line] =~ /^From: (.*)/ ) {
X			$from = $1;
X			last from;
X		}
X	}
X	#
X	# No From: line
X	#
X	#
X	if ( $line > $#header) {
X		return '';
X	}
X	# Try to extract actual address from $from line
X	# look for <bangpath> form first, since that's what uunet
X	# put's into the From: line
X	if ( $from =~ /<(.*)>/ ) {
X		$Address = $1;
X	}
X	else {
X		# try From: address ( comment )
X		if ( $from =~ /(.*) \(.*\)/ ) {
X			$Address = $1;
X		}
X		else {
X			# just use whatever's there
X			$Address = $from;
X		}
X	}
X	# get rid of any whitespace following the address
X	($Address,$junk) = split(/[ \t]/,$Address);
X	# return the address
X	$Address;
X} # end subroutine getaddr
X
X#
X# subroutine getuser($address) -
X# extract the username from an address and check to make sure it isn't
X# one of the "forbidden" usernames. Returns either null or the username.
X#
X
Xsub getuser {
X	local($addr) = pop(@_);
X	#
X	# if sender is uucp, news, mailer-daemon, etc., junk the message
X	# get the last ! component
X	@phase1 = split(/!/,$addr);
X	$usr = $phase1[$#phase1];
X	# get whatever sits in front of an "@".
X	@phase2 = split(/@/,$usr);
X	$usr = $phase2[0];
X	# get whatever precedes a "%"
X	@phase3 = split(/%/,$usr);
X	$usr = $phase3[0];
X
X	# check for anything that might conceivably be the username
X	# of something that bounces mail, rather than a person. We
X	# also exclude root, simply because there are too many root
X	# users doing system administration at some sites.
X	study $usr;
X	if ( $usr =~ /MAILER/i) { return(''); }
X	if ( $usr =~ /DAEMON/i)	{ return(''); }
X	if ( $usr =~ /uucp/i)	{ return(''); }
X	if ( $usr =~ /POSTMASTER/i)	{ return(''); }
X	if ( $usr =~ /DELIVER/i) { return(''); }
X	if ( $usr =~ /news/i)	{ return(''); }
X	if ( $usr =~ /root/)	{ return(''); }
X	$usr;
X} # end subroutine getuser
X
X# subroutine getsubj - search through the global array @header until
X# we find a Subject: line. Extract and return the subject.
X
Xsub getsubj {
X	#
X	# Get Subject: line from header
X	$subj = '';
X	for ($line = 0; $line <= $#header; $line++ ) {
X		if ( $header[$line] =~ /^Subject: (.*)$/ ) {
X			$subj = $1;
X			last ;
X		}
X	}
X	$subj;
X} # end subroutine getsubj
X
X#
X# subroutine getsender($address) - given the address of the sender of
X# a message, find hir alias in the real2alias database and return the
X# alias. If the sender is not in the database, add them. Returns the
X# sender's alias.
X
Xsub getsender {
X	local($addr) = pop(@_);
X	#
X	# Lookup sender in real2alias db
X	$Salias = $r2a{$addr};
X	if ( ! defined($Salias)) {
X		# create alias for sender
X		$alias_index++;
X		$Salias = "acs-".$alias_index;
X		# add the newbie to the database
X		$r2a{"$addr"} = $Salias;
X		# Add alias to /usr/lib/aliases
X		open(SYSALIAS,">>/usr/lib/aliases") || 
X			die "Can't write to aliases file: $!\n";
X		print SYSALIAS "$Salias: \"|/usr/personals/anon-reply $Salias\"\n";
X		close(SYSALIAS);
X		#
X		# need to execute newaliases here if sendmail doesn't
X		# support OD flag to automatically update dbm database
X		# of course, this is irrelevant if the MTA doesn't
X		# use dbm database.
X		# system("/usr/ucb/newaliases");
X	}
X	# return the alias
X	$Salias;
X} # end subroutine getsender
END_OF_FILE
if test 13090 -ne `wc -c <'unspool'`; then
    echo shar: \"'unspool'\" unpacked with wrong size!
fi
chmod +x 'unspool'
# end of 'unspool'
fi
echo shar: End of archive 7 \(of 8\).
cp /dev/null ark7isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 8 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0