Date: Fri, 02 Feb 1996 15:31:46 -0800 From: "Jordan K. Hubbard" <jkh@time.cdrom.com> To: hackers@freebsd.org Cc: doc@freebsd.org Subject: Any perl maniacs out there have a desire to improve our mail robot? Message-ID: <6938.823303906@time.cdrom.com>
next in thread | raw e-mail | index | archive | help
Many of you have probably never even used our hardworking and
unthanked robot information service which lives at info@freebsd.org,
but if you have a few spare moments, I urge you to poke at it a bit.
This is what answered some 103K requests for information last year,
and I'm almost certain that it can be improved.
The biggest problem the info robot service has right now is stale
information brought about by the fact that the info robot has its own
copies of everything. There are no links into our other docs, nor are
any search services offered (which limits its utility somewhat).
For those many folks still stuck with email as their only recourse, it
seems like we could try a little harder to make this robot more useful!
Any takers? We could bat some attempts at a functional spec around
first if people aren't quite sure what to do, though I'd think the
enhancements would almost tend to suggest themselves.. :-)
First on the list would be hot links to current docs, whereever those
might be (I don't think we have ascii excerpts from the handbook on
freefall - suggestions?), then perhaps some ability to search the
archives in /usr/local/mail/archive and return messages matched (up to
some max threshold) by date/subject/pattern/mailing list.
If someone wanted to get *really* fancy, they could even try to write
an automated question parser which matches queries up with specially
prepared FAQ entries.. Should be, what, 3 or 4 lines of PERL? :-)
The current info robot source follows.. I don't know PERL, so most of
my hacking on this has been pretty light. It's mostly as Ian Holland
first submitted it.
Thanks!
Jordan
# Copyright (c) 1994 Ian Holland
# All rights reserved.
# Redistribution and use, with or without modification, is permitted
# provided that the following condition is met:
# 1. Redistributions of source code must retain the above copyright
# notice and this list of conditions.
#
# Author: ianh@brillig.brisnet.org.au, ianh@mincom.oz.au
# Version: $Id: mreply,v 1.1 1994/09/28 09:44:18 ianh Exp ianh $
#
# The following variable need to be customised for local conditions.
#
# $home should be set to the directory containing informational files.
# See %filelist below.
$home = "/home/majordomo/info";
# $LOGFILE should be a path to a log of all the activity by this script.
$LOGFILE = "$home/LOGFILE";
# $LOCKFILE is a file used to ensure that only one process writes to
# the $LOGFILE at a time. Well, I hope it does anyway.
$LOCKFILE = "$home/.lock";
# $Hlist is the name of the server - it may be descriptive.
$Hlist = "info";
# $Hsite is the domain name of the server site.
$Hsite = "FreeBSD.org";
# $Hreply is the (server) user that email is sent to, without domain.
# Users will send mail to $Hreply@$Hsite
$Hreply = "info";
# $sendmail should be the command that allows addresses to be specified
# in the text of the message (standard input).
$sendmail = "/usr/sbin/sendmail -t";
# $tempfile is a temporary file that holds the reply to a users request.
# In this case, it checks for a value in the environment variables $TMP
# and $TMPDIR (if neither is set "/tmp" is used), and uses a file
# called "mreply.$$" in that directory. $$ is the PID of the current
# perl program.
$tempfile = ($ENV{'TMP'} || $ENV{'TMPDIR'} || "/tmp") . "/mreply.$$";
# %filelist is an associative array. The index is a name that users
# request via the "send FILE" command. Note that these names are
# case sensitive.
# The value associated with each index is a set of two colon (':')
# seperated fields. The first field is a path to the actual file,
# while the second is a description of the file.
%filelist = (
BLURB, "$home/BLURB:General information on FreeBSD",
README, "$home/README.TXT:General welcome notes for FreeBSD 2.1",
FAQ, "$home/freebsd-faq:FreeBSD Frequently Answered Questions",
HANDBOOK, "$home/handbook:The FreeBSD 2.1 handbook",
INSTALL, "$home/INSTALL.TXT:The FreeBSD 2.1 installation guide",
RELNOTES, "$home/RELNOTES.TXT:The FreeBSD 2.1 release notes",
CTM, "$home/ctm.FAQ:Getting the most up-to-date FreeBSD sources by mail",
SUP, "$home/sup.FAQ:Getting the most up-to-date FreeBSD sources by Internet"
,
MIRROR_SITES, "$home/MIRROR.SITES:A list of FTP sites for obtaining FreeBSD"
,
);
# Set your umask here. Use normal umask(1) numerical syntax.
umask(007);
#############################################################################
# Everything past this point is set in concrete (albeit wet concrete).
# Nothing should need to be changed below here for local conditions. It may
# need to be changed to fix bugs, though.
#
&parseheader(STDIN, *hdrs);
$replyto = &replyaddress(*hdrs);
&initlogging($LOGFILE, $LOCKFILE);
open(STDOUT, ">$tempfile") || die "Cannot open $tempfile: $!\n";
($srt = $replyto) =~ s/\t/ /g;
$messageid = join("\t",
sprintf("%02.2d"x6, (localtime())[5,4,3,2,1,0]),
$srt);
# Process the message - should we look at the subject line?
while (<STDIN>) {
if (/^help\s*$/) {
push(@work, "help");
&sendhelp();
}
elsif (/^info\s*$/) {
push(@work, "info");
&sendfile("BLURB");
}
elsif (/^list\s*$/) {
push(@work, "list");
&sendfilelist();
}
elsif (/^reply\s+(\S+)/) {
$replyto = $1;
push(@work, "reply($replyto)");
}
elsif (/^send\s+(\S+)/) {
$file = $1;
push(@work, "send($file)");
&sendfile($file);
}
}
if ($#work < $[) {
# No recognisable commands, so we'll send the standard blurb.
push(@work, "default-info");
&sendfile("BLURB");
}
grep(s/$/ /, @work);
close STDOUT;
&sendmail($replyto, $tempfile, *hdrs);
unlink $tempfile;
&log($messageid, "\t", @work);
exit 0;
sub sendhelp {
print <<"EOH";
Welcome to $Hreply@$Hsite
The following commands are recognised by this server. Each command must
be contained on a line by itself, with no leading whitespace.
Command What will happen
help this message will be sent
info an information sheet on FreeBSD will be sent
list a list of files that may be requested will be sent
reply this will set the return path, in case of bad headers
send FILE the specified file will be sent
EOH
}
sub sendfilelist {
local($key, @list);
local($desc);
@list = sort keys %filelist;
printf "%-24.24s%s\n", "Name", "Description";
print "\n";
foreach $key (@list) {
$desc = (split(/:/, $filelist{$key}, 2))[1];
printf "%-24.24s%s\n", $key, $desc;
}
print "\n";
}
sub sendfile {
local($index) = $_[0];
local($path, $desc, $_);
if (!defined($filelist{$index})) {
print "The file you have requested ($index) is not available\n";
print "from this server.\n";
print "You may use the command \"list\" to get a list\n";
print "of the available files.\n";
return;
}
($path, $desc) = split(/:/, $filelist{$index}, 2);
open(FILE, "<$path") || do {
print "The file $index is temporarily unavailable.\n";
&log("*** error *** Cannot read $index ($path)");
return;
};
while (<FILE>) {
print;
}
close FILE;
}
sub sendmail {
local($address, $file, *headers) = @_;
local($_);
open(REPLY, "<$file") || die "Cannot open $file: $!\n";
open(EMAIL, "|$sendmail") || die "Cannot exec $sendmail: $!\n";
print EMAIL <<"EOM";
To: $address
From: $Hlist
Subject: Your mail to $Hreply@$Hsite
In-Reply-To: $headers{'message-id'}, from $headers{'from'}
Reply-To: $Hreply@$Hsite
EOM
while (<REPLY>) {
print EMAIL $_;
}
close EMAIL;
close REPLY;
}
package logging;
sub main'initlogging {
($file, $lock) = @_;
}
sub main'log {
&lock();
open(LOG, ">>$file") || die "Cannot write to log file ($file): $!\n";
print LOG join("", @_), "\n";
close LOG;
&unlock();
}
sub lock {
local($umask);
$umask = umask(0777);
while (!open(LOCK, ">$lock")) {
sleep 1;
}
print LOCK $$;
close LOCK;
umask $umask;
}
sub unlock {
unlink $lock;
}
package mailheader;
sub main'parseheader {
local($fh, *headers) = @_;
local($_, @lines);
local($*, $/) = (1, "\n\n");
local($field, $value);
$_ = <$fh>;
s/\n(.)/\n$1$1/g;
@lines = split(/\n\S/);
grep(s/\n\s+/ /g, @lines);
foreach $_ (@lines) {
($field, $value) = split(/:\s*/, $_, 2);
$field =~ tr[A-Z][a-z];
$headers{$field} = $value if !($field =~ /\s/);
}
}
sub main'replyaddress {
local(*headers) = $_[0];
local($rc);
$rc = $headers{'reply-to'} || $headers{'from'};
}
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?6938.823303906>