From: aks%anywhere@hub.ucsb.edu (Alan Stebbens)
Newsgroups: comp.lang.perl
Subject: Re: Perl-Users Digest #471
Date: 30 Jul 92 20:40:15 GMT
Reply-To: aks%anywhere@hub.ucsb.edu
Organization: The Internet

I've been using the audit.pl script for a few weeks, and I've cobbled
together some minor changes, added a Makefile to install things, and
created a sample .audit script which I've been installing for various
users who have expressed needs like (a) handling mail while on vacation,
(b) throwing away junk mail from noisy mailing lists.

What follows is the script, and then a diff to the original audit
release.  If anyone wants the complete distribution, it's available via
anonymouse ftp on hub.ucsb.edu:/pub/mail/audit.tar.Z

I apologize to the author for not mailing this directly; I can't seem to
find your email address anywhere within the distribution, and I've long
since lost the original mail from which it came.

Enjoy.

Alan Stebbens        <aks@hub.ucsb.edu>             (805) 893-3221
     Center for Computational Sciences and Engineering (CCSE)
          University of California, Santa Barbara (UCSB)
           3111 Engineering I, Santa Barbara, CA 93106


============================= cut here ===================================
#!/eci/bin/perl
#
# $Date: 1992/07/30 19:55:42 $
# $Revision: 1.1 $

# Tailor this for yourself

@MyNames = ('FIRSTNAME', 'LASTNAME');

# This is a sample audit script.  It looks for a file with the
# name "~/.vacation.msg", and if it exists, assumes that the user
# is on vacation, and operates under "vacation mode", otherwise,
# works under "work mode".
#
# In either case, mail from the mailer daemon, or any mail addressed
# directly to the user is assumed to be important, and is not
# filtered for junk mail.  In vacation mode, the mail is answered
# automatically, using the ".vacation.msg" file as the reply message.
# Then, the mail is simply dropped in the system mailbox.
#
# If the mail is not directly addressed, then it is coming from a 
# mailing list, and is filtered through the junk mail lists, which
# are determined by one of two files, depending upon the mode.  In
# work mode, the file is ".junkmail.work"; in vacation mode, the
# file is ".junkmail.vacation".
#
# The junkmail lists contain names of mailing lists which are to be
# subject to junking; that is, mail with headers having one of these
# junk mailing list names in either the To: or Cc: header, and NOT 
# directly addressed to the user are junked.
#
# As part of the junking, a log file is kept, called ".junkmail.log";
# the From:, Date:, To:, Cc:, and Subject: lines are recorded.
#
# The ".junkmail.work" is especially useful for those occasions when
# a particular mailing list gets crowded with some emotional issue
# for which you have no interest.  Rather than having your name removed
# from the mailing list, just filter it until the signal-to-noise
# ratio improves (which can be deteremined by scanning the log file
# periodically).
#
($Prog = $0) =~ s=^/.*([^/]+)$=$1=; # get plain program name

require 'audit.pl' || die "~/.audit: cannot include audit.pl: $@";

# Only if you need some of the mh functions
# require 'mh.pl'  || die "~/.audit: cannot include mh.pl: $@";

&initialize();

$HOME = $ENV{'HOME'};
$VacaJunkMail = "$HOME/.junkmail.vacation";
$WorkJunkMail = "$HOME/.junkmail.work";
$JunkLogFile =	"$HOME/.junkmail.log";

$OnVacation = -f "$HOME/.vacation.msg";
$AtWork = ! $OnVacation;

# If this message came from the MAILER, deliver it to me directly
# and do nothing else.

($from =~ /MAILER/) && do { &deliver(); exit; };

# If the sender's name is in the password file, the organization
# is local

$local_org = $ENV{'ORGANIZATION'};
chop($local_org = `cat $HOME/.organization`) 
	if -f "$HOME/.organization" && !length($local_org);

if ($local_org) {
    $organization = $local_org if ($logname = (getpwnam($from))[0]);
}

# If I am specifically named on the To or Cc line, do the default.

unshift(@MyNames,$user);

foreach $name (@MyNames) {
    if (grep(/^$name/i, @to, @cc)) {
	&deliver();			# deposit in my mailbox
	&vacation() if $OnVacation;	# do the vacation response (maybe)
	exit;
    }
};

# The mail wasn't sent directly to me, so, if I'm at work, look for 
# any junkmail list names

if ($AtWork) {
    foreach $junkname (&ReadNames($WorkJunkMail)) {
	$junkname =~ s/([-+.])/\\$1/g;	# make grep-safe
	&Junk if grep(/^$junkname/i, @to, @cc);
    }
}
    
# this mail was not sent to me directly, nor was it on the at-work junk 
# mailing list, so now check for at-vacation junk mails, if I'm on vacation.

if ($OnVacation) {
    foreach $junkname (&ReadNames($VacaJunkMail)) {
	$junkname =~ s/([-+.])/\\$1/g;	# make grep-safe
	&Junk if grep(/^$junkname/i, @to, @cc);
    }
}

# Oh well, some mailing list which might be important.

&deliver();
exit;

# Subroutine ReadNames -- opens a file and reads all the names within it,
# allowing for comments lines and commented lines

sub ReadNames {
    local($file) = @_;
    local($_);
    local(@names,$name);
    return () unless -f $file;
    if (open(LIST,$file)) {
	while (<LIST>) {
	    next if /^\s*#/;
	    s/\s*\#.*$//;	# strip comments
	    next if /^\s*$/;	# ignore empty lines
	    push(@names,split(' '));
	}
	close LIST;
    } else {
	warn "$Prog: can't read $file because $!\n";
    }
    @names;
}

sub Junk {
    local($hdr) = "%-9s %s\n";
    if (open(LOG,">>$JunkLogFile")) {
	$friendly = '' if $friendly eq 'unknown';
	$organization = '' if $organization eq 'unknown';
	$from = '"'.$friendly.'"' if $friendly;
	$from .= ' <'.$address.'>';
	$from .= ' ('.$organization.')' if $organization;
	printf LOG $hdr,'From:',$from;
	printf LOG $hdr,'Date:',$headers{'date'};
	printf LOG $hdr,'To:',join(', ',@to) if $#to >= $[;
	printf LOG $hdr,'Cc:',join(', ',@cc) if $#cc >= $[;
	printf LOG $hdr,'Subject:',$subject;
	printf LOG "\n";
	close LOG;
    }
    exit;
}
============================= cut here ===================================
diff -r -c audit.ref/CHANGES audit/CHANGES
*** audit.ref/CHANGES	Thu Jul 30 18:41:23 1992
--- audit/CHANGES	Thu Jul 30 19:32:01 1992
***************
*** 1,3 ****
--- 1,13 ----
+ Changes file ($Revision$)
+ 
+ Added code to chown newly created files to be owned by $user, rather than
+ the uid of the running process, if running as root.
+ 
+ Create a Makefile to install things; the Makefile needs site-configuration
+ of course.
+ 
+ Modified mh.pl to ease site-configuration.
+ 
  V0.2 Changes 
  ============
  
diff -r -c audit.ref/Makefile audit/Makefile
*** audit.ref/Makefile	Thu Jul 30 19:17:07 1992
--- audit/Makefile	Thu Jul 30 19:30:04 1992
***************
*** 0 ****
--- 1,42 ----
+ # Makefile for the audit.pl package
+ #
+ # $Author: aks $ $Date: 1992/07/30 19:30:02 $
+ # $Revision: 1.1 $
+ 
+ # Set LIB_DIR to the directory in which to install "audit.pl" and "mh.pl"
+ LIB_DIR = /eci/share/lib/perl
+ 
+ # BIN_DIR should be the path in which to install the executable scripts; these
+ # scripts can be shared across architectures
+ 
+ BIN_DIR = /eci/share/bin
+ 
+ # If PERL_PATH is set, the first line of each script will be set to this
+ # pathname in order to invoke Perl
+ 
+ PERL_PATH = /eci/bin/perl
+ 
+ LIB_FILES = audit.pl mh.pl
+ SCRIPTS = refileto rfolder
+ 
+ INSTALL = /usr/ucb/install
+ 
+ INSTALL_BIN =	sed -e '1s=^\(.!\)/.*=\1$(PERL_PATH)=' $? > $@ ; chmod 755 $@
+ INSTALL_LIB =	$(INSTALL) -c -m 444 $? $@
+ INSTALL_LINK =	( cd $(@D) ; ln -s $(?F) $(@F) )
+ 
+ install:	libs	scripts	links
+ 
+ libs:		$(LIB_DIR) $(LIB_DIR)/audit.pl $(LIB_DIR)/mh.pl
+ $(LIB_DIR)/audit.pl:	audit.pl ;		$(INSTALL_LIB)
+ $(LIB_DIR)/mh.pl:	mh.pl ;			$(INSTALL_LIB)
+ 
+ scripts:	$(BIN_DIR) $(BIN_DIR)/refileto $(BIN_DIR)/rfolder
+ $(BIN_DIR)/refileto:	refileto ;		$(INSTALL_BIN)
+ $(BIN_DIR)/rfolder:	rfolder	 ;		$(INSTALL_BIN)
+ 
+ links:		$(BIN_DIR)/refilefrom	$(BIN_DIR)/rfolders
+ $(BIN_DIR)/refilefrom:	$(BIN_DIR)/refileto ;	$(INSTALL_LINK)
+ $(BIN_DIR)/rfolders:	$(BIN_DIR)/rfolder ;	$(INSTALL_LINK)
+ 
+ $(LIB_DIR) $(BIN_DIR): ; mkdir $@
Only in audit: RCS
diff -r -c audit.ref/audit.pl audit/audit.pl
*** audit.ref/audit.pl	Thu Jul 30 19:23:03 1992
--- audit/audit.pl	Thu Jul 30 19:24:22 1992
***************
*** 1,7 ****
  #
  #
! # $Revision: 1.13 $
! # $Date: 1992/05/12 14:34:18 $
  #
  #
  
--- 1,7 ----
  #
  #
! # $Revision: 1.14 $
! # $Date: 1992/07/30 19:24:07 $
  #
  #
  
***************
*** 19,25 ****
      $ENV{'USER'} = $user;
      $ENV{'HOME'} = $home;
      $ENV{'SHELL'} = $shell;
!     $ENV{'TERM'} = "vt100";
  
      &parse_message(STDIN);
  }
--- 19,28 ----
      $ENV{'USER'} = $user;
      $ENV{'HOME'} = $home;
      $ENV{'SHELL'} = $shell;
!     if (!$> && !$uid) {		# root and user isn't?
! 	$< = $uid; $> = $uid;
! 	$( = $gid; $) = $gid;
!     }
  
      &parse_message(STDIN);
  }
***************
*** 275,285 ****
--- 278,291 ----
  
  # =====
  #	Put the incoming mail into the specified mail drop (file)
+ #	[Alan Stebbens, UCSB, 7/30/92]
+ #	Be sure to make the file owned by the user, if possible.
  #
  sub deposit {
      local($drop) = @_;
      local($LOCK_EX) = 2;
      local($LOCK_UN) = 8;
+     local($needchown) = ! -f $drop;	# flag if chown is needed
  
      open(MAIL, ">> $drop") || die "open: $!\n";
      flock(MAIL, $LOCK_EX);
***************
*** 290,295 ****
--- 296,305 ----
  
      flock(MAIL, $LOCK_UN);
      close(MAIL);
+     if ($needchown) {
+ 	local($fgid) = (stat($drop))[5];	# get file's current gid
+ 	chown $uid,$fgid,$drop;
+     }
  }
  
  
diff -r -c audit.ref/mh.pl audit/mh.pl
*** audit.ref/mh.pl	Thu Jul 30 18:41:24 1992
--- audit/mh.pl	Thu Jul 30 19:25:43 1992
***************
*** 1,5 ****
--- 1,11 ----
+ # $Date: 1992/07/30 19:25:42 $
+ # $Revision: 1.2 $
  
+ # Configure this for your site
  
+ $MH_BIN = '/eci/mh/bin';
+ $MH_LIB = '/eci/mh/lib';
+ 
  # =====
  # Subroutine mh_profile
  #	Parse the user's .mh_profile and get arguments and settings
***************
*** 32,38 ****
  sub rcvstore {
      local($folder) = @_;
  
!     &openpipe("/usr/local/bin/mh/lib/rcvstore +$folder -create");
  }
  
  
--- 38,44 ----
  sub rcvstore {
      local($folder) = @_;
  
!     &openpipe("$MH_LIB/rcvstore +$folder -create");
  }
  
  
***************
*** 45,51 ****
  sub rcvdist {
      local($recips) = @_;
  
!     &openpipe("/usr/local/bin/mh/lib/rcvdist $recips");
  }
  
  
--- 51,57 ----
  sub rcvdist {
      local($recips) = @_;
  
!     &openpipe("$MH_LIB/rcvdist $recips");
  }
  
  
***************
*** 56,62 ****
  #
  sub rcvtty {
  
!     &openpipe("/usr/local/bin/mh/lib/rcvtty");
  }
  
  
--- 62,68 ----
  #
  sub rcvtty {
  
!     &openpipe("$MH_LIB/rcvtty");
  }
  
  
***************
*** 70,76 ****
      local($recips); 
      local(@list) = ();
  
!     $recips = `/usr/local/bin/mh/ali $alias`;
      chop $recips;
      return(@list) if ($alias eq $recips);
  
--- 76,82 ----
      local($recips); 
      local(@list) = ();
  
!     $recips = `$MH_BIN/ali $alias`;
      chop $recips;
      return(@list) if ($alias eq $recips);
  
diff -r -c audit.ref/refilefrom audit/refilefrom
*** audit.ref/refilefrom	Thu Jul 30 18:41:24 1992
--- audit/refilefrom	Thu Jul 30 19:30:12 1992
***************
*** 1,5 ****
--- 1,8 ----
  #!/usr/bin/perl
  
+ # $Date: 1992/07/30 19:30:10 $
+ # $Revision: 1.1 $
+ 
  $program = $0;
  $program =~ s|.*/||;
  $| = 1;
diff -r -c audit.ref/refileto audit/refileto
*** audit.ref/refileto	Thu Jul 30 18:41:24 1992
--- audit/refileto	Thu Jul 30 19:30:12 1992
***************
*** 1,5 ****
--- 1,8 ----
  #!/usr/bin/perl
  
+ # $Date: 1992/07/30 19:30:10 $
+ # $Revision: 1.1 $
+ 
  $program = $0;
  $program =~ s|.*/||;
  $| = 1;
diff -r -c audit.ref/rfolder audit/rfolder
*** audit.ref/rfolder	Thu Jul 30 18:41:24 1992
--- audit/rfolder	Thu Jul 30 19:30:12 1992
***************
*** 1,5 ****
--- 1,8 ----
  #!/usr/bin/perl
  
+ # $Date: 1992/07/30 19:30:10 $
+ # $Revision: 1.1 $
+ 
  $program = $0;
  $program =~ s|.*/||;
  $| = 1;
diff -r -c audit.ref/rfolders audit/rfolders
*** audit.ref/rfolders	Thu Jul 30 18:41:24 1992
--- audit/rfolders	Thu Jul 30 19:30:12 1992
***************
*** 1,5 ****
--- 1,8 ----
  #!/usr/bin/perl
  
+ # $Date: 1992/07/30 19:30:10 $
+ # $Revision: 1.1 $
+ 
  $program = $0;
  $program =~ s|.*/||;
  $| = 1;
diff -r -c audit.ref/sample.audit audit/sample.audit
*** audit.ref/sample.audit	Thu Jul 30 19:57:15 1992
--- audit/sample.audit	Thu Jul 30 19:55:43 1992
***************
*** 0 ****
--- 1,151 ----
+ #!/eci/bin/perl
+ #
+ # $Date: 1992/07/30 19:55:42 $
+ # $Revision: 1.1 $
+ 
+ # Tailor this for yourself
+ 
+ @MyNames = ('FIRSTNAME', 'LASTNAME');
+ 
+ # This is a sample audit script.  It looks for a file with the
+ # name "~/.vacation.msg", and if it exists, assumes that the user
+ # is on vacation, and operates under "vacation mode", otherwise,
+ # works under "work mode".
+ #
+ # In either case, mail from the mailer daemon, or any mail addressed
+ # directly to the user is assumed to be important, and is not
+ # filtered for junk mail.  In vacation mode, the mail is answered
+ # automatically, using the ".vacation.msg" file as the reply message.
+ # Then, the mail is simply dropped in the system mailbox.
+ #
+ # If the mail is not directly addressed, then it is coming from a 
+ # mailing list, and is filtered through the junk mail lists, which
+ # are determined by one of two files, depending upon the mode.  In
+ # work mode, the file is ".junkmail.work"; in vacation mode, the
+ # file is ".junkmail.vacation".
+ #
+ # The junkmail lists contain names of mailing lists which are to be
+ # subject to junking; that is, mail with headers having one of these
+ # junk mailing list names in either the To: or Cc: header, and NOT 
+ # directly addressed to the user are junked.
+ #
+ # As part of the junking, a log file is kept, called ".junkmail.log";
+ # the From:, Date:, To:, Cc:, and Subject: lines are recorded.
+ #
+ # The ".junkmail.work" is especially useful for those occasions when
+ # a particular mailing list gets crowded with some emotional issue
+ # for which you have no interest.  Rather than having your name removed
+ # from the mailing list, just filter it until the signal-to-noise
+ # ratio improves (which can be deteremined by scanning the log file
+ # periodically).
+ #
+ ($Prog = $0) =~ s=^/.*([^/]+)$=$1=; # get plain program name
+ 
+ require 'audit.pl' || die "~/.audit: cannot include audit.pl: $@";
+ 
+ # Only if you need some of the mh functions
+ # require 'mh.pl'  || die "~/.audit: cannot include mh.pl: $@";
+ 
+ &initialize();
+ 
+ $HOME = $ENV{'HOME'};
+ $VacaJunkMail = "$HOME/.junkmail.vacation";
+ $WorkJunkMail = "$HOME/.junkmail.work";
+ $JunkLogFile =	"$HOME/.junkmail.log";
+ 
+ $OnVacation = -f "$HOME/.vacation.msg";
+ $AtWork = ! $OnVacation;
+ 
+ # If this message came from the MAILER, deliver it to me directly
+ # and do nothing else.
+ 
+ ($from =~ /MAILER/) && do { &deliver(); exit; };
+ 
+ # If the sender's name is in the password file, the organization
+ # is local
+ 
+ $local_org = $ENV{'ORGANIZATION'};
+ chop($local_org = `cat $HOME/.organization`) 
+ 	if -f "$HOME/.organization" && !length($local_org);
+ 
+ if ($local_org) {
+     $organization = $local_org if ($logname = (getpwnam($from))[0]);
+ }
+ 
+ # If I am specifically named on the To or Cc line, do the default.
+ 
+ unshift(@MyNames,$user);
+ 
+ foreach $name (@MyNames) {
+     if (grep(/^$name/i, @to, @cc)) {
+ 	&deliver();			# deposit in my mailbox
+ 	&vacation() if $OnVacation;	# do the vacation response (maybe)
+ 	exit;
+     }
+ };
+ 
+ # The mail wasn't sent directly to me, so, if I'm at work, look for 
+ # any junkmail list names
+ 
+ if ($AtWork) {
+     foreach $junkname (&ReadNames($WorkJunkMail)) {
+ 	$junkname =~ s/([-+.])/\\$1/g;	# make grep-safe
+ 	&Junk if grep(/^$junkname/i, @to, @cc);
+     }
+ }
+     
+ # this mail was not sent to me directly, nor was it on the at-work junk 
+ # mailing list, so now check for at-vacation junk mails, if I'm on vacation.
+ 
+ if ($OnVacation) {
+     foreach $junkname (&ReadNames($VacaJunkMail)) {
+ 	$junkname =~ s/([-+.])/\\$1/g;	# make grep-safe
+ 	&Junk if grep(/^$junkname/i, @to, @cc);
+     }
+ }
+ 
+ # Oh well, some mailing list which might be important.
+ 
+ &deliver();
+ exit;
+ 
+ # Subroutine ReadNames -- opens a file and reads all the names within it,
+ # allowing for comments lines and commented lines
+ 
+ sub ReadNames {
+     local($file) = @_;
+     local($_);
+     local(@names,$name);
+     return () unless -f $file;
+     if (open(LIST,$file)) {
+ 	while (<LIST>) {
+ 	    next if /^\s*#/;
+ 	    s/\s*\#.*$//;	# strip comments
+ 	    next if /^\s*$/;	# ignore empty lines
+ 	    push(@names,split(' '));
+ 	}
+ 	close LIST;
+     } else {
+ 	warn "$Prog: can't read $file because $!\n";
+     }
+     @names;
+ }
+ 
+ sub Junk {
+     local($hdr) = "%-9s %s\n";
+     if (open(LOG,">>$JunkLogFile")) {
+ 	$friendly = '' if $friendly eq 'unknown';
+ 	$organization = '' if $organization eq 'unknown';
+ 	$from = '"'.$friendly.'"' if $friendly;
+ 	$from .= ' <'.$address.'>';
+ 	$from .= ' ('.$organization.')' if $organization;
+ 	printf LOG $hdr,'From:',$from;
+ 	printf LOG $hdr,'Date:',$headers{'date'};
+ 	printf LOG $hdr,'To:',join(', ',@to) if $#to >= $[;
+ 	printf LOG $hdr,'Cc:',join(', ',@cc) if $#cc >= $[;
+ 	printf LOG $hdr,'Subject:',$subject;
+ 	printf LOG "\n";
+ 	close LOG;
+     }
+     exit;
+ }
Newsgroups: comp.lang.perl