home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Usenet 1994 October
/
usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso
/
misc
/
volume44
/
mailagent
/
patch15
< prev
next >
Wrap
Internet Message Format
|
1994-09-22
|
45KB
From: Raphael Manfredi <ram@acri.fr>
Newsgroups: comp.sources.misc
Subject: v44i089: mailagent - Flexible mail filtering and processing package, v3.0, Patch15
Date: 22 Sep 1994 12:13:34 -0500
Organization: Advanced Computer Research Institute, Lyon, France
Sender: kent@sparky.sterling.com
Approved: kent@sparky.sterling.com
Message-ID: <35sdvu$r61@sparky.sterling.com>
X-Md4-Signature: 0339e7f8db2cb18c857919fa40217f01
Submitted-by: Raphael Manfredi <ram@acri.fr>
Posting-number: Volume 44, Issue 89
Archive-name: mailagent/patch15
Environment: UNIX, Perl
Patch-To: mailagent: Volume 41, Issue 1-26
[The latest patch for mailagent version 3.0 is #16.]
System: mailagent version 3.0
Patch #: 15
Priority: MEDIUM
Subject: patch #12, continued
Date: Thu Sep 22 17:04:37 MET DST 1994
From: Raphael Manfredi <ram@acri.fr>
Description:
See patch #12.
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your mailagent source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #16 FIRST ***
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Raphael Manfredi <ram@acri.fr>
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH mailagent 3.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
To get some more detailed instructions, send me the following mail:
Subject: Command
@SH mailhelp PATH
Index: patchlevel.h
Prereq: 14
4c4
< #define PATCHLEVEL 14
---
> #define PATCHLEVEL 15
Index: MANIFEST
*** MANIFEST.old Thu Sep 22 16:43:32 1994
--- MANIFEST Thu Sep 22 16:43:32 1994
***************
*** 10,15 ****
--- 10,16 ----
agent/Jmakefile High level description of Makefile
agent/Makefile.SH Makefile which builds and installs mailagent
agent/README Welcome to mailagent
+ agent/edusers.SH Edits users file with proper locking procedure
agent/examples/ A set of files from my own environment
agent/examples/README Explains what the examples are
agent/examples/daemon Rules for "vacation" emulation
***************
*** 83,88 ****
--- 84,90 ----
agent/man/ Manual pages for mailagent
agent/man/Jmakefile Makefile description for jmake
agent/man/Makefile.SH Makefile for manual pages extraction
+ agent/man/edusers.SH Produces a manual page for edusers
agent/man/mailagent.SH Produces a manual page for mailagent
agent/man/maildist.SH Produces a manual page for maildist
agent/man/mailhelp.SH Produces a manual page for mailhelp
***************
*** 94,101 ****
--- 96,105 ----
agent/pl/acs_rqst.pl Perl library to ask for private file access
agent/pl/actions.pl Implementation of mailagent's actions
agent/pl/add_log.pl Perl library to add logs to logfile
+ agent/pl/addr.pl Approximate address matching and validation
agent/pl/analyze.pl Perl library analyzing the incoming mail
agent/pl/builtins.pl Perl library dealing with builtins
+ agent/pl/callout.pl Perl library to handle callout queue
agent/pl/checklock.pl Perl library to check for long lasting locks
agent/pl/cmdserv.pl Implements generic mail server
agent/pl/compress.pl Folder compression library
***************
*** 131,136 ****
--- 135,141 ----
agent/pl/mmdf.pl MMDF-style mailbox handling
agent/pl/newcmd.pl Filter command extension driver
agent/pl/once.pl Dealing with once commands
+ agent/pl/package.pl Sources dist's .package file into pkg package
agent/pl/parse.pl Perl library to parse a mail message
agent/pl/period.pl Perl library to compute periods
agent/pl/plsave.pl Perl library to handle the plsave cache file
***************
*** 146,151 ****
--- 151,157 ----
agent/pl/runcmd.pl Filter commands ran from here
agent/pl/secure.pl Make sure a file is "secure" and can be trusted
agent/pl/sendfile.pl Perl library to send files in shar / kit mode
+ agent/pl/signals.pl Installs emergency signal handlers
agent/pl/stats.pl Mailagent's statistics recording and printing
agent/pl/tilde.pl Perl library to perform ~name expansion
agent/pl/umask.pl Handles UMASK in local mode
***************
*** 157,168 ****
--- 163,176 ----
agent/test/README About the regression tests
agent/test/TEST Runs the full test suite
agent/test/actions Rule file for cmd tests
+ agent/test/atail Active monitoring of the out/agentlog file
agent/test/basic/ Basic tests
agent/test/basic/config.t Main test initialization and sanity checks
agent/test/basic/filter.t Make sure C filter works
agent/test/basic/mailagent.t Make sure mailagent basically works
agent/test/cmd/ Tests of mailagent's filtering commands
agent/test/cmd/abort.t Test ABORT command
+ agent/test/cmd/after.t Test AFTER command
agent/test/cmd/annotate.t Test ANNOTATE command
agent/test/cmd/apply.t Test APPLY command
agent/test/cmd/assign.t Test ASSIGN command
***************
*** 170,175 ****
--- 178,184 ----
agent/test/cmd/begin.t Test BEGIN command
agent/test/cmd/bounce.t Test BOUNCE command
agent/test/cmd/delete.t Test DELETE command
+ agent/test/cmd/do.t Test DO command
agent/test/cmd/feed.t Test FEED command
agent/test/cmd/forward.t Test FORWARD command
agent/test/cmd/give.t Test GIVE command
Index: agent/pl/addr.pl
*** agent/pl/addr.pl.old Thu Sep 22 16:43:04 1994
--- agent/pl/addr.pl Thu Sep 22 16:43:04 1994
***************
*** 0 ****
--- 1,96 ----
+ ;# $Id: addr.pl,v 3.0.1.1 1994/09/22 14:08:28 ram Exp $
+ ;#
+ ;# Copyright (c) 1990-1993, Raphael Manfredi
+ ;#
+ ;# You may redistribute only under the terms of the Artistic License,
+ ;# as specified in the README file that comes with the distribution.
+ ;# You may reuse parts of this distribution only within the terms of
+ ;# that same Artistic License; a copy of which may be found at the root
+ ;# of the source tree for mailagent 3.0.
+ ;#
+ ;# $Log: addr.pl,v $
+ ;# Revision 3.0.1.1 1994/09/22 14:08:28 ram
+ ;# patch12: created
+ ;#
+ ;#
+ package addr;
+
+ #
+ # Address stuff, for mailing list maintainance (package command)
+ #
+
+ # Is address valid?
+ # Addresses containing either '|' or '/' in them are considered hostile, since
+ # sendmail for instance would attempt to deliver to a program or to a file...
+ # Also, the address must not contain any space or control characters.
+ sub valid {
+ local($_) = @_;
+ return 0 if $_ eq ''; # Empty address
+ return 0 if tr/\0-\31//; # Control character found
+ return 0 if /\s/; # No space in address
+ return 0 if m,/|\|,; # No / or | please
+ 1; # Address is ok
+ }
+
+ # Simplify address for comparaison purposes
+ sub simplify {
+ local($_) = @_;
+
+ return &simplify($_) if s/^@[\w-.]+://; # @b.c:x -> x and retry
+ return "$2@$1.uucp" if /^([\w-]+)!(\w+)$/; # b!u -> u@b.uucp
+ return "$2@$1" if /^([\w-.]+)!(\w+)$/; # b.c!u -> u@b.c
+ return $_ if /^\w+@[\w-.]+$/; # u@b.c
+ return &simplify("$2!$3")
+ if /([^%@]+)!([\w-.]+)!(\w+)$/; # ...!b!u -> b!u
+ return "$1@$2" if /^(\w+)%([\w-.]+)@[\w-.]+/; # u%b.c@d.e -> u@b.c
+ return &simplify($1) if s/(.*)@[\w-.]+$//; # x@b.c -> x and retry
+ return &simplify("$1@$2")
+ if /^([\w-.%!]+)%([\w-.]+)$/; # x%b -> x@b and retry
+
+ return $_; # Hmm... Better stop here, since we are clueless!!
+ }
+
+ # Does first address matches second address?
+ sub match {
+ local($a1, $a2) = @_; # Two plain e-mail addresses (no comments)
+ $a1 =~ tr/A-Z/a-z/; # Cannonicalize to lower case
+ $a2 =~ tr/A-Z/a-z/;
+ local($s1) = &simplify($a1);
+ local($s2) = &simplify($a2);
+ return 1 if $s1 eq $s2;
+ # Face ram@lyon.eiffel.com versus ram@york.eiffel.com or ram@eiffel.com
+ # We do not want a match in the first case, but it's ok for the other one.
+ local($p1, $p2) = ($s1, $s2);
+ $p1 =~ s/(\W)/\\$1/g;
+ $p2 =~ s/(\W)/\\$1/g;
+ $p1 =~ s/@/@[\\w-]+\\./;
+ $p2 =~ s/@/@[\\w-]+\\./;
+ $s1 =~ /^$p2$/ || $s2 =~ /^$p1$/;
+ }
+
+ # Are the two addresses close?
+ # They are if they match or if their login name is the same or they are
+ # within the same subdomain.domain.country or domain.country.
+ sub close {
+ local($a1, $a2) = @_; # Two plain e-mail addresses (no comments)
+ return 1 if &match($a1, $a2);
+ $a1 =~ tr/A-Z/a-z/; # Cannonicalize to lower case
+ $a2 =~ tr/A-Z/a-z/;
+ $a1 = &simplify($a1);
+ $a2 = &simplify($a2);
+ local($l1, $l2); # Login names
+ local($d1, $d2); # Domain names
+ ($l1) = $a1 =~ /^(.*)@/;
+ ($l2) = $a2 =~ /^(.*)@/;
+ return 1 if $l1 ne '' && $l1 eq $l2;
+ ($d1) = $a1 =~ /([\w-]+\.[\w-]+\.[\w]+)$/;
+ ($d2) = $a2 =~ /([\w-]+\.[\w-]+\.[\w]+)$/;
+ return 1 if $d1 ne '' && $d1 eq $d2;
+ ($d1) = $a1 =~ /([\w-]+\.[\w]+)$/;
+ ($d2) = $a2 =~ /([\w-]+\.[\w]+)$/;
+ return 1 if $d1 ne '' && $d1 eq $d2;
+ return 0;
+ }
+
+ package main;
+
Index: agent/pl/dynload.pl
Prereq: 3.0
*** agent/pl/dynload.pl.old Thu Sep 22 16:43:08 1994
--- agent/pl/dynload.pl Thu Sep 22 16:43:08 1994
***************
*** 1,4 ****
! ;# $Id: dynload.pl,v 3.0 1993/11/29 13:48:40 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 1,4 ----
! ;# $Id: dynload.pl,v 3.0.1.1 1994/09/22 14:17:09 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 9,14 ****
--- 9,17 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: dynload.pl,v $
+ ;# Revision 3.0.1.1 1994/09/22 14:17:09 ram
+ ;# patch12: added the &do routine to support new DO filtering command
+ ;#
;# Revision 3.0 1993/11/29 13:48:40 ram
;# Baseline for mailagent 3.0 netwide release.
;#
***************
*** 18,23 ****
--- 21,37 ----
;# array. The %Loaded array records the files which have already been loaded
;# so that we do not load the same file twice. The key records the package
;# name and then the file, separated by a ':'.
+ ;#
+ ;# Additionally, the &do routine can be given an argument of the form:
+ ;# package'routine
+ ;# COMMAND:package'routine
+ ;# file:package'routine
+ ;# and would then call &load with the proper arguments. Of course, in the first
+ ;# case, nothing is to be done but to check that the routine is already there.
+ ;# The second and third case enable loading of a routine from a specific file,
+ ;# of from a file defining a new command. Distinction is made by looking at
+ ;# the commands first, which should not be the source of too many conflicts
+ ;# when a path with '/' is given...
#
# Load function into package
#
***************
*** 82,87 ****
--- 96,140 ----
return 0; # Eval failed
}
1; # Ok so far
+ }
+
+ # Inspect their request closely, trying to guess what they really want. The
+ # general pattern they can give us is:
+ # something:routine
+ # where something may be a command name or a path name, or may be missing
+ # entirely up to the ':' separator, and routine is a qualified or unqualified
+ # routine name, using the single quote as package separator, and not :: as in
+ # perl5 or C++ -- I loathe that token, maybe because I loathe C++ so much?
+ # Returns success condition, or undef if file cannot be loaded (missing?).
+ sub do {
+ local($routine) = @_;
+ $routine =~ s/::/'/; # Despite what leading comment says, be perl5 aware
+ local($something);
+ $routine =~ s/^([^:]*):// && ($something = $1);
+ $routine = "main'$routine" unless $routine =~ /'/;
+ return 1 if $something eq '' && defined &$routine; # Already there
+ return 0 if $something eq ''; # Not there, no clue how to get it
+
+ # Ok, at that point we know the routine is not there, but by looking
+ # at $something, we might be able to find out where that routine might
+ # be found... First check whether it is the name of a user-defined command
+ # in which case we load that file and get the command. Otherwise, the
+ # remaining is taken as a path where the routine may be found.
+
+ local($cmd) = $something;
+ local($path);
+ $cmd =~ tr/a-z/A-Z/; # Cannonicalize to upper case
+ if (defined $newcmd'Usercmd{$cmd}) {
+ $path = $newcmd'Usercmd{$cmd}; # Get command's path
+ } else {
+ $path = $something; # Must be a path then
+ $path =~ s/~/$cf'home/; # ~ substitution
+ }
+
+ local($package);
+ ($package, $routine) = $routine =~ m|(.*)'(.*)|;
+
+ return &load($package, $path, $routine);
}
package main;
Index: agent/pl/filter.pl
Prereq: 3.0.1.2
*** agent/pl/filter.pl.old Thu Sep 22 16:43:11 1994
--- agent/pl/filter.pl Thu Sep 22 16:43:11 1994
***************
*** 1,4 ****
! ;# $Id: filter.pl,v 3.0.1.2 1994/07/01 15:00:30 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 1,4 ----
! ;# $Id: filter.pl,v 3.0.1.3 1994/09/22 14:20:43 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 9,14 ****
--- 9,18 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: filter.pl,v $
+ ;# Revision 3.0.1.3 1994/09/22 14:20:43 ram
+ ;# patch12: propagated change to the &queue_mail interface
+ ;# patch12: added stubs for DO and AFTER commands
+ ;#
;# Revision 3.0.1.2 1994/07/01 15:00:30 ram
;# patch8: new UMASK command
;#
***************
*** 52,58 ****
sub run_process {
if (0 != &process) {
&add_log("ERROR while processing [$mfile]--queing it") if $loglvl;
! &queue_mail($file_name);
return 1;
}
&add_log("PROCESSED [$mfile]") if $loglvl > 8;
--- 56,62 ----
sub run_process {
if (0 != &process) {
&add_log("ERROR while processing [$mfile]--queing it") if $loglvl;
! &queue_mail($file_name, 'fm');
return 1;
}
&add_log("PROCESSED [$mfile]") if $loglvl > 8;
***************
*** 561,569 ****
# Mail is saved as a 'qm' file, to avoid endless loops when mailagent
# processes the queue. This means the mail will be deferred for at
# least half an hour.
! local($failed) = &queue_mail('', 1); # No file name, mail in %Header
! $ever_saved = 1 unless $failed; # Queuing counts as saving
! $failed;
}
# Run the PERL command
--- 565,573 ----
# Mail is saved as a 'qm' file, to avoid endless loops when mailagent
# processes the queue. This means the mail will be deferred for at
# least half an hour.
! local($name) = &queue_mail('', 'qm'); # No file name, mail in %Header
! $ever_saved = 1 if defined $name; # Queuing counts as saving
! defined $name ? 0 : 1; # Failed if $name is undef
}
# Run the PERL command
***************
*** 617,622 ****
--- 621,653 ----
$local = $local ? ' locally' : '';
&add_log("UMASK [$mfile] set to ${omask}$local") if $loglvl > 7;
0; # Ok
+ }
+
+ # Run the AFTER command
+ sub run_after {
+ local($type, $time, $action) = $cmd =~ m|^\w+\s+(-[sanc]\s+)?\((.*)\)(.*)|;
+ local($failed, $queued) = &after($time, $action, $type);
+ unless ($failed) {
+ local(@msg);
+ push(@msg, 'shell') if $type =~ /s/;
+ push(@msg, 'agent') if $type =~ /a/ || $type eq '';
+ push(@msg, 'command') if $type =~ /c/;
+ push(@msg, 'no input') if $type =~ /n/;
+ local($type) = join(', ', @msg);
+ local($qmsg) = $queued ne '-' ? "-> $queued" : '';
+ &add_log("AFTER [$mfile$qmsg] $time {$action} ($type)") if $loglvl > 3;
+ }
+ $failed; # Failure status
+ }
+
+ # Run the DO command
+ sub run_do {
+ local($what, $args) = $cmd =~ m|^\w+\s+([^()\s]*)(.*)|;
+ local($something, $routine) = $what =~ m|^([^:]*):(.*)|;
+ $routine = $what if $something eq '';
+ local($failed) = &do($something, $routine, $args);
+ &add_log("DONE [$mfile] $routine$args") if $loglvl > 7 && !$failed;
+ $failed; # Failure status
}
# For SAVE, STORE or WRITE, the job is the same
Index: agent/pl/rules.pl
Prereq: 3.0.1.1
*** agent/pl/rules.pl.old Thu Sep 22 16:43:22 1994
--- agent/pl/rules.pl Thu Sep 22 16:43:22 1994
***************
*** 1,4 ****
! ;# $Id: rules.pl,v 3.0.1.1 1994/04/25 15:23:03 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 1,4 ----
! ;# $Id: rules.pl,v 3.0.1.2 1994/09/22 14:36:40 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 9,14 ****
--- 9,17 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: rules.pl,v $
+ ;# Revision 3.0.1.2 1994/09/22 14:36:40 ram
+ ;# patch12: lock rule cache before reading to prevent from concurrent updates
+ ;#
;# Revision 3.0.1.1 1994/04/25 15:23:03 ram
;# patch7: added locking protections when updating rule cache
;#
***************
*** 237,243 ****
$printed += length($pattern) + 7;
}
}
! print " " if $lines == 1 && $printed += 2;
# Split actions, but take care of escaped \; (layout purposes)
$action =~ s/\\\\/\02/g; # \\ -> ^B
--- 240,246 ----
$printed += length($pattern) + 7;
}
}
! print " " if $lines == 1 && ($printed += 2);
# Split actions, but take care of escaped \; (layout purposes)
$action =~ s/\\\\/\02/g; # \\ -> ^B
***************
*** 324,336 ****
# Since the '-r' option may also need to cache rules and no mailagent lock
# is taken in that case, we need to lock the rule file before accessing it.
sub read_cache {
- return 0 unless &cache_ok;
- local(*CACHE); # File handle used to read the cache
- local($_);
if (0 != &'acs_rqst($cf'rulecache)) {
&'add_log("NOTICE unable to read-lock $cf'rulecache") if $'loglvl > 6;
return 0; # Cannot read
}
open(CACHE, $cf'rulecache) || return 0; # Cannot open, assume out of date
$_ = <CACHE>; # Disregard top line
while (<CACHE>) { # First read the @Rules
--- 327,342 ----
# Since the '-r' option may also need to cache rules and no mailagent lock
# is taken in that case, we need to lock the rule file before accessing it.
sub read_cache {
if (0 != &'acs_rqst($cf'rulecache)) {
&'add_log("NOTICE unable to read-lock $cf'rulecache") if $'loglvl > 6;
return 0; # Cannot read
}
+ unless (&cache_ok) {
+ &'free_file($cf'rulecache);
+ return 0; # Cache outdated
+ }
+ local(*CACHE); # File handle used to read the cache
+ local($_);
open(CACHE, $cf'rulecache) || return 0; # Cannot open, assume out of date
$_ = <CACHE>; # Disregard top line
while (<CACHE>) { # First read the @Rules
***************
*** 355,360 ****
--- 361,367 ----
}
# Is cache up-to-date with respect to the rule file? Returns true if cache ok.
+ # The rule file should be read-locked by the caller.
sub cache_ok {
return 0 unless defined $cf'rulecache;
local(*CACHE); # File handle used to read the cache
Index: agent/pl/interface.pl
Prereq: 3.0.1.1
*** agent/pl/interface.pl.old Thu Sep 22 16:43:13 1994
--- agent/pl/interface.pl Thu Sep 22 16:43:13 1994
***************
*** 1,4 ****
! ;# $Id: interface.pl,v 3.0.1.1 1994/07/01 15:01:19 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 1,4 ----
! ;# $Id: interface.pl,v 3.0.1.2 1994/09/22 14:23:38 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 9,14 ****
--- 9,18 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: interface.pl,v $
+ ;# Revision 3.0.1.2 1994/09/22 14:23:38 ram
+ ;# patch12: mailhook package cleaning now done only for subroutines
+ ;# patch12: package name is separated with '::' in perl5
+ ;#
;# Revision 3.0.1.1 1994/07/01 15:01:19 ram
;# patch8: new UMASK command
;# patch8: cannot dataload exit
***************
*** 97,103 ****
local($args) = join(' ', @_); # Arguments for the command
local($name) = (caller(1))[3]; # Function which called us
local($status); # Continuation status
! $name =~ s/^\w+'//; # Strip leading package name
&'add_log("calling '$name $args'") if $'loglvl > 18;
$status = &'run_command("$name $args"); # Case does not matter
--- 101,107 ----
local($args) = join(' ', @_); # Arguments for the command
local($name) = (caller(1))[3]; # Function which called us
local($status); # Continuation status
! $name =~ s/^\w+('|::)//; # Strip leading package name
&'add_log("calling '$name $args'") if $'loglvl > 18;
$status = &'run_command("$name $args"); # Case does not matter
***************
*** 135,144 ****
# Loop over perl's symbol table for the mailhook package
while (($key, $val) = each(%_mailhook)) {
local(*entry) = $val; # Get definitions of current slot
! undef $entry unless length($key) == 1 && $key !~ /^\w/;
! undef @entry;
! undef %entry unless $key =~ /^_/ || $key eq 'header';
! undef &entry if &valid($key);
$_mailhook{$key} = *entry; # Commit our changes
}
}
--- 139,152 ----
# Loop over perl's symbol table for the mailhook package
while (($key, $val) = each(%_mailhook)) {
local(*entry) = $val; # Get definitions of current slot
! # Temporarily disable those. They are causing problems with perl
! # 4.0 PL36 on some machines when running PERL escapes. Keep only
! # the removal of functions since the re-definition of routines is
! # the most harmful with perl 4.0.
! #undef $entry unless length($key) == 1 && $key !~ /^\w/;
! #undef @entry;
! #undef %entry unless $key =~ /^_/ || $key eq 'header';
! undef &entry if defined &entry && &valid($key);
$_mailhook{$key} = *entry; # Commit our changes
}
}
Index: agent/test/TEST
Prereq: 3.0.1.1
*** agent/test/TEST.old Thu Sep 22 16:43:26 1994
--- agent/test/TEST Thu Sep 22 16:43:26 1994
***************
*** 2,8 ****
eval 'exec perl -S $0 "$@"'
if $running_under_some_shell;
! # $Id: TEST,v 3.0.1.1 1993/12/15 09:04:45 ram Exp $
#
# Copyright (c) 1990-1993, Raphael Manfredi
#
--- 2,8 ----
eval 'exec perl -S $0 "$@"'
if $running_under_some_shell;
! # $Id: TEST,v 3.0.1.2 1994/09/22 14:40:10 ram Exp $
#
# Copyright (c) 1990-1993, Raphael Manfredi
#
***************
*** 13,18 ****
--- 13,21 ----
# of the source tree for mailagent 3.0.
#
# $Log: TEST,v $
+ # Revision 3.0.1.2 1994/09/22 14:40:10 ram
+ # patch12: new -m option to monitor agentlog changes via atail
+ #
# Revision 3.0.1.1 1993/12/15 09:04:45 ram
# patch3: now force . into PATH for msend/nsend
#
***************
*** 28,33 ****
--- 31,37 ----
$ENV{'USER'} = 'nobody'; # In case we get mails back from RUN and friends
$ENV{'PWD'} = $pwd;
$ENV{'LEVEL'} = 0; # Default loglvl for filter and cmd tests
+ delete $ENV{'ENV'}; # For ksh
@tests = ('basic', 'option', 'filter', 'cmd', 'misc');
$failed = 0;
***************
*** 53,58 ****
--- 57,73 ----
$ENV{'LEVEL'} = int($level);
}
+ # Launch atail if -m to monitor the agentlog file
+ if ($opt_m) {
+ $atail_pid = fork;
+ unlink 'out/agentlog';
+ if (defined $atail_pid && $atail_pid == 0) {
+ # Child process
+ exec 'perl ./atail';
+ die "TEST: could not launch atail: $!\n";
+ }
+ }
+
unless (-f 'OK') {
%Ok = ();
`rm -rf out` if -d 'out';
***************
*** 86,97 ****
}
&clean_up;
! exit 0; # End of tests
#
# Subroutines
#
sub clean_up {
return if $failed || $opt_i; # -i asks for incrementality
unlink 'OK';
--- 101,118 ----
}
&clean_up;
! &exit(0); # End of tests
#
# Subroutines
#
+ sub exit {
+ local($code) = @_;
+ kill(15, $atail_pid) if $atail_pid;
+ exit $code;
+ }
+
sub clean_up {
return if $failed || $opt_i; # -i asks for incrementality
unlink 'OK';
***************
*** 139,145 ****
}
if ($failed && $opt_s) { # Stop at first error if -s
print "Aborted tests.\n";
! exit 0;
}
}
--- 160,166 ----
}
if ($failed && $opt_s) { # Stop at first error if -s
print "Aborted tests.\n";
! &exit(0);
}
}
***************
*** 166,172 ****
sub basic_failed {
print "Failed a basic test, cannot continue.\n";
unlink 'OK';
! exit 0;
}
sub load_ok {
--- 187,193 ----
sub basic_failed {
print "Failed a basic test, cannot continue.\n";
unlink 'OK';
! &exit(0);
}
sub load_ok {
Index: agent/pl/runcmd.pl
Prereq: 3.0.1.1
*** agent/pl/runcmd.pl.old Thu Sep 22 16:43:22 1994
--- agent/pl/runcmd.pl Thu Sep 22 16:43:23 1994
***************
*** 1,4 ****
! ;# $Id: runcmd.pl,v 3.0.1.1 1994/07/01 15:04:58 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 1,4 ----
! ;# $Id: runcmd.pl,v 3.0.1.2 1994/09/22 14:37:08 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 9,14 ****
--- 9,17 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: runcmd.pl,v $
+ ;# Revision 3.0.1.2 1994/09/22 14:37:08 ram
+ ;# patch12: new DO and AFTER commands
+ ;#
;# Revision 3.0.1.1 1994/07/01 15:04:58 ram
;# patch8: new UMASK command
;#
***************
*** 22,33 ****
--- 25,38 ----
;#
;# The following commands are available (case is irrelevent):
;# ABORT Aborts filtering right away
+ ;# AFTER time <cmd> Records command in the callout queue
;# ANNOTATE field <value> Annotation in header a la MH
;# APPLY rulefile Apply an alternate rule file on message
;# ASSIGN var <value> Assign value to the user-defined variable
;# BACK <cmd> Execute <cmd> and eval its output
;# BEGIN state Enter in a new state for analysis
;# BOUNCE address(es) As FORWARD but leave header intact
+ ;# DO routine(args) Call perl routine
;# DELETE Trash the mail away
;# FEED program Same as PASS, but the whole message is given
;# FORWARD address(es) Forwards mail to specified addresses
***************
*** 165,176 ****
--- 170,183 ----
sub init_filter {
%Filter = (
'ABORT', 'run_abort', # Aborts application of filtering rules
+ 'AFTER', 'run_after', # Records callout action
'ANNOTATE', 'run_annotate', # Add new field into header
'APPLY', 'run_apply', # Apply alternate rule file on message
'ASSIGN', 'run_assign', # Assign value to variable
'BACK', 'run_back', # Eval feedback
'BEGIN', 'run_begin', # Enter in a new state
'BOUNCE', 'run_bounce', # Bounce message
+ 'DO', 'run_do', # Call perl routine directly
'DELETE', 'run_delete', # Throw mail away, explicitely
'FEED', 'run_feed', # Feed back mail through program
'FORWARD', 'run_forward', # Forward mail
***************
*** 213,218 ****
--- 220,226 ----
%Rfilter = (
'BACK', 1,
'BOUNCE', 1,
+ 'DO', 1,
'FEED', 1,
'FORWARD', 1,
'GIVE', 1,
Index: agent/Jmakefile
Prereq: 3.0
*** agent/Jmakefile.old Thu Sep 22 16:42:45 1994
--- agent/Jmakefile Thu Sep 22 16:42:45 1994
***************
*** 2,8 ****
* Jmakefile for mailagent
*/
! ;# $Id: Jmakefile,v 3.0 1993/11/29 13:47:37 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 2,8 ----
* Jmakefile for mailagent
*/
! ;# $Id: Jmakefile,v 3.0.1.1 1994/09/22 13:39:09 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 13,23 ****
;# of the source tree for mailagent 3.0.
;#
;# $Log: Jmakefile,v $
;# Revision 3.0 1993/11/29 13:47:37 ram
;# Baseline for mailagent 3.0 netwide release.
;#
! BIN = mailpatch mailhelp maillist maildist package
NoManPages()
ShellScriptTarget($(BIN))
--- 13,26 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: Jmakefile,v $
+ ;# Revision 3.0.1.1 1994/09/22 13:39:09 ram
+ ;# patch12: new edusers script to edit users file
+ ;#
;# Revision 3.0 1993/11/29 13:47:37 ram
;# Baseline for mailagent 3.0 netwide release.
;#
! BIN = mailpatch mailhelp maillist maildist package edusers
NoManPages()
ShellScriptTarget($(BIN))
Index: agent/man/Jmakefile
Prereq: 3.0
*** agent/man/Jmakefile.old Thu Sep 22 16:42:55 1994
--- agent/man/Jmakefile Thu Sep 22 16:42:55 1994
***************
*** 2,8 ****
* Jmakefile for mailagent's manual pages
*/
! ;# $Id: Jmakefile,v 3.0 1993/11/29 13:48:25 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 2,8 ----
* Jmakefile for mailagent's manual pages
*/
! ;# $Id: Jmakefile,v 3.0.1.1 1994/09/22 13:52:52 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 13,18 ****
--- 13,21 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: Jmakefile,v $
+ ;# Revision 3.0.1.1 1994/09/22 13:52:52 ram
+ ;# patch12: new manual page for edusers
+ ;#
;# Revision 3.0 1993/11/29 13:48:25 ram
;# Baseline for mailagent 3.0 netwide release.
;#
***************
*** 20,25 ****
>L /* I expect to fix this with an |append command */
MPAGES = mailagent.$(L) maildist.$(L) maillist.$(L) mailhelp.$(L) \
! mailpatch.$(L) package.$(L)
ComplexShellManualTarget($(MPAGES))
--- 23,28 ----
>L /* I expect to fix this with an |append command */
MPAGES = mailagent.$(L) maildist.$(L) maillist.$(L) mailhelp.$(L) \
! mailpatch.$(L) package.$(L) edusers.$(L)
ComplexShellManualTarget($(MPAGES))
Index: agent/test/atail
*** agent/test/atail.old Thu Sep 22 16:43:27 1994
--- agent/test/atail Thu Sep 22 16:43:27 1994
***************
*** 0 ****
--- 1,79 ----
+ : # feed this into perl
+ eval 'exec perl -S $0 "$@"'
+ if $running_under_some_shell;
+
+ # $Id: atail,v 3.0.1.1 1994/09/22 14:40:37 ram Exp $
+ #
+ # Copyright (c) 1990-1993, Raphael Manfredi
+ #
+ # You may redistribute only under the terms of the Artistic License,
+ # as specified in the README file that comes with the distribution.
+ # You may reuse parts of this distribution only within the terms of
+ # that same Artistic License; a copy of which may be found at the root
+ # of the source tree for mailagent 3.0.
+ #
+ # $Log: atail,v $
+ # Revision 3.0.1.1 1994/09/22 14:40:37 ram
+ # patch12: created
+ #
+
+ # Active monitoring of out/agentlog. This is going to be a CPU hog, but is
+ # intended to debug stall cases or weird mailagent errors.
+ # Launched automatically with the -m (monitor) option of TEST.
+ # Aborts when parent becomes init after 5 seconds of delay, just in case
+ # the TEST program dies without having a chance to kill us.
+
+ $LOG = 'out/agentlog'; # Log file
+ $open = 0; # True when file opened
+ $size = 0; # Last file size
+
+ $SIG{'ALRM'} = 'check_parent';
+ alarm(5);
+
+ select STDOUT;
+ $| = 1;
+
+ for (;;) {
+ &close_file if !-e $LOG && $open;
+ next unless -f _;
+ &new_file unless $open;
+ &check_size if $open;
+ }
+
+ # Log file disappeared
+ sub close_file {
+ print "** Log removed\n";
+ close LOG;
+ $open = 0;
+ $size = 0;
+ }
+
+ # File reappeared
+ sub new_file {
+ print "** New log file\n";
+ open(LOG, $LOG);
+ $open = 1;
+ }
+
+ # Print whatever there is in the file after $size bytes
+ sub check_size {
+ $now = -s _;
+ if ($now < $size) {
+ print "** Replaced log file\n";
+ open(LOG, $LOG);
+ $size = 0;
+ }
+ seek(LOG, $size, 0);
+ sysread(LOG, $buf, $now - $size);
+ $size = $now;
+ print $buf;
+ }
+
+ # Make sure our parent is not init
+ sub check_parent {
+ die "atail: parent process died, exiting\n" if getppid == 1;
+ # Don't know whether perl re-instantiates handlers when kernel doesn't
+ $SIG{'ALRM'} = 'check_parent';
+ alarm(5);
+ }
+
Index: agent/files/filter.sh
Prereq: 3.0
*** agent/files/filter.sh.old Thu Sep 22 16:42:48 1994
--- agent/files/filter.sh Thu Sep 22 16:42:48 1994
***************
*** 1,6 ****
#!/bin/sh
! # $Id: filter.sh,v 3.0 1993/11/29 13:47:51 ram Exp $
#
# Copyright (c) 1990-1993, Raphael Manfredi
#
--- 1,6 ----
#!/bin/sh
! # $Id: filter.sh,v 3.0.1.1 1994/09/22 13:41:43 ram Exp $
#
# Copyright (c) 1990-1993, Raphael Manfredi
#
***************
*** 11,16 ****
--- 11,19 ----
# of the source tree for mailagent 3.0.
#
# $Log: filter.sh,v $
+ # Revision 3.0.1.1 1994/09/22 13:41:43 ram
+ # patch12: filter.sh now honours queuewait when defined
+ #
# Revision 3.0 1993/11/29 13:47:51 ram
# Baseline for mailagent 3.0 netwide release.
#
***************
*** 154,165 ****
tqtemp=$queue/Tqmb$$
fi
# Do not write in a 'qm' file directly, or the mailagent might start
# its processing on an incomplete file.
if cp $temp $tqtemp; then
mv $tqtemp $qtemp
if test x = "x$busy"; then
! sleep 60
if perl -S mailagent $qtemp; then
rm -f $temp $qtemp $spool/filter.lock
exit 0
--- 157,172 ----
tqtemp=$queue/Tqmb$$
fi
+ # Set a proper waiting time. If queuewait is not defined in the config file,
+ # let it default to 60 seconds.
+ test "$queuewait" || queuewait=60
+
# Do not write in a 'qm' file directly, or the mailagent might start
# its processing on an incomplete file.
if cp $temp $tqtemp; then
mv $tqtemp $qtemp
if test x = "x$busy"; then
! sleep $queuewait
if perl -S mailagent $qtemp; then
rm -f $temp $qtemp $spool/filter.lock
exit 0
***************
*** 169,175 ****
set 'ERROR unable to queue mail before processing'
eval $addlog
if test x = "x$busy"; then
! sleep 60
if perl -S mailagent $temp; then
rm -f $temp $spool/filter.lock
exit 0
--- 176,182 ----
set 'ERROR unable to queue mail before processing'
eval $addlog
if test x = "x$busy"; then
! sleep $queuewait
if perl -S mailagent $temp; then
rm -f $temp $spool/filter.lock
exit 0
Index: agent/pl/analyze.pl
Prereq: 3.0.1.3
*** agent/pl/analyze.pl.old Thu Sep 22 16:43:05 1994
--- agent/pl/analyze.pl Thu Sep 22 16:43:05 1994
***************
*** 1,4 ****
! ;# $Id: analyze.pl,v 3.0.1.3 1994/07/01 14:59:58 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 1,4 ----
! ;# $Id: analyze.pl,v 3.0.1.4 1994/09/22 14:09:03 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 9,14 ****
--- 9,17 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: analyze.pl,v $
+ ;# Revision 3.0.1.4 1994/09/22 14:09:03 ram
+ ;# patch12: defines new folder_saved variable to store folder path
+ ;#
;# Revision 3.0.1.3 1994/07/01 14:59:58 ram
;# patch8: general umask is now reset before analyzing a message
;# patch8: added support for the UMASK command for local rule scope
***************
*** 60,65 ****
--- 63,69 ----
# are external to &apply_rules.
local($ever_matched) = 0; # Did we ever matched a single saving rule ?
local($ever_saved) = 0; # Did we ever saved a message ?
+ local($folder_saved) = ''; # Last folder we saved into (full path)
# Other local variables used only in this function
local($ever_seen) = 0; # Did we ever enter seen mode ?
***************
*** 73,79 ****
&parse_mail($file); # Parse the mail and fill-in H tables
return 0 unless defined $Header{'All'}; # Mail not parsed correctly
&reception if $loglvl > 8; # Log mail reception
! &run_builtins; # Execute builtins, if any were found
# Now analyze the mail. If there is already a X-Filter header, then the
# mail has already been processed. In that case, the default action is
--- 77,83 ----
&parse_mail($file); # Parse the mail and fill-in H tables
return 0 unless defined $Header{'All'}; # Mail not parsed correctly
&reception if $loglvl > 8; # Log mail reception
! &run_builtins; # Execute builtins, if any
# Now analyze the mail. If there is already a X-Filter header, then the
# mail has already been processed. In that case, the default action is
Index: agent/test/option/l.t
Prereq: 3.0
*** agent/test/option/l.t.old Thu Sep 22 16:43:29 1994
--- agent/test/option/l.t Thu Sep 22 16:43:29 1994
***************
*** 1,6 ****
# -l: list message queue (special)
! # $Id: l.t,v 3.0 1993/11/29 13:50:18 ram Exp $
#
# Copyright (c) 1990-1993, Raphael Manfredi
#
--- 1,6 ----
# -l: list message queue (special)
! # $Id: l.t,v 3.0.1.1 1994/09/22 14:41:21 ram Exp $
#
# Copyright (c) 1990-1993, Raphael Manfredi
#
***************
*** 11,21 ****
--- 11,25 ----
# of the source tree for mailagent 3.0.
#
# $Log: l.t,v $
+ # Revision 3.0.1.1 1994/09/22 14:41:21 ram
+ # patch12: now checks that callout messages are properly listed
+ #
# Revision 3.0 1993/11/29 13:50:18 ram
# Baseline for mailagent 3.0 netwide release.
#
do '../pl/init.pl';
+ do '../pl/logfile.pl';
chdir '../out';
unlink <queue/*>;
open(MBOX, ">mbox") || print "1\n";
***************
*** 58,62 ****
$? == 0 || print "5\n";
$output_bis = `./mailqueue 2>/dev/null`;
$output eq $output_bis || print "6\n";
! unlink <queue/*>, 'mbox', 'mailqueue';
print "0\n";
--- 62,81 ----
$? == 0 || print "5\n";
$output_bis = `./mailqueue 2>/dev/null`;
$output eq $output_bis || print "6\n";
!
! # Ensure callout messages are also listed
! `$mailagent -f mbox -e 'AFTER -a (now + 1 day) DELETE; DELETE' 2>/dev/null`;
! $? == 0 || print "7\n";
! @qfiles = <queue/[qf]m*>;
! @cfiles = <queue/cm*>;
! @qfiles == 3 || print "8\n";
! @cfiles == 3 || print "9\n";
!
! # Make sure there are three messages queued and three callouts reported
! @log = `$mailagent -l 2>/dev/null`;
! &check_log('Now', 10) == 3 || print "11\n";
! &check_log('Skipped', 12) == 3 || print "13\n";
! &check_log('Callout', 14) == 3 || print "15\n";
!
! unlink <queue/*>, 'mbox', 'mailqueue', 'context', 'callout';
print "0\n";
Index: agent/filter/misc.c
Prereq: 3.0
*** agent/filter/misc.c.old Thu Sep 22 16:42:51 1994
--- agent/filter/misc.c Thu Sep 22 16:42:51 1994
***************
*** 11,17 ****
*/
/*
! * $Id: misc.c,v 3.0 1993/11/29 13:48:16 ram Exp $
*
* Copyright (c) 1990-1993, Raphael Manfredi
*
--- 11,17 ----
*/
/*
! * $Id: misc.c,v 3.0.1.1 1994/09/22 13:45:30 ram Exp $
*
* Copyright (c) 1990-1993, Raphael Manfredi
*
***************
*** 22,27 ****
--- 22,30 ----
* of the source tree for mailagent 3.0.
*
* $Log: misc.c,v $
+ * Revision 3.0.1.1 1994/09/22 13:45:30 ram
+ * patch12: added fallback implementation for strcasecmp()
+ *
* Revision 3.0 1993/11/29 13:48:16 ram
* Baseline for mailagent 3.0 netwide release.
*
***************
*** 29,34 ****
--- 32,38 ----
#include "config.h"
#include "portable.h"
+ #include <ctype.h>
#include "confmagic.h"
extern char *malloc(); /* Memory allocation */
***************
*** 48,51 ****
--- 52,82 ----
strcpy(new, string);
return new;
}
+
+ #ifndef HAS_STRCASECMP
+ /*
+ * This is a rather inefficient version of the strcasecmp() routine which
+ * compares two strings in a case-independant manner. The libc routine uses
+ * an array, which when indexed by character code, directly yields the lower
+ * case version of that character. Here however, since the routine is only
+ * used in a few places, we don't bother being as efficient.
+ */
+ public int strcasecmp(s1, s2)
+ char *s1;
+ char *s2;
+ {
+ char c1, c2;
+
+ while (c1 = *s1++, c2 = *s2++, c1 && c2) {
+ if (isupper(c1))
+ c1 = tolower(c1);
+ if (isupper(c2))
+ c2 = tolower(c2);
+ if (c1 != c2)
+ break; /* Strings are different */
+ }
+
+ return c1 - c2; /* Will be 0 if both string ended */
+ }
+ #endif
Index: config_h.SH
Prereq: 3.0.1.2
*** config_h.SH.old Thu Sep 22 16:43:31 1994
--- config_h.SH Thu Sep 22 16:43:31 1994
***************
*** 25,31 ****
* that running config.h.SH again will wipe out any changes you've made.
* For a more permanent change edit config.sh and rerun config.h.SH.
*
! * \$Id: config_h.SH,v 3.0.1.2 1994/07/01 15:15:19 ram Exp $
*/
/* Configuration time: $cf_time
--- 25,31 ----
* that running config.h.SH again will wipe out any changes you've made.
* For a more permanent change edit config.sh and rerun config.h.SH.
*
! * \$Id: config_h.SH,v 3.0.1.3 1994/09/22 14:41:59 ram Exp $
*/
/* Configuration time: $cf_time
***************
*** 94,99 ****
--- 94,105 ----
*/
#$d_setsid HAS_SETSID /**/
+ /* HAS_STRCASECMP:
+ * This symbol, if defined, indicates that the strcasecmp() routine is
+ * available for case-insensitive string compares.
+ */
+ #$d_strccmp HAS_STRCASECMP /**/
+
/* HAS_INDEX:
* This symbol is defined to indicate that the index()/rindex()
* functions are available for string searching.
***************
*** 183,188 ****
--- 189,200 ----
#$i_sysioctl I_SYS_IOCTL /**/
#$d_voidtty USE_TIOCNOTTY /**/
+ /* I_SYS_PARAM:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/param.h>.
+ */
+ #$i_sysparam I_SYS_PARAM /**/
+
/* I_SYS_WAIT:
* This symbol, if defined, indicates to the C program that it should
* include <sys/wait.h>.
***************
*** 264,269 ****
--- 276,286 ----
#define register4 $reg4 /**/
#define register5 $reg5 /**/
#define register6 $reg6 /**/
+
+ /* ROOTID:
+ * This symbol contains the uid of root, normally 0.
+ */
+ #define ROOTID $rootid /**/
/* Uid_t:
* This symbol holds the type used to declare user ids in the kernel.
Index: agent/pl/parse.pl
Prereq: 3.0.1.2
*** agent/pl/parse.pl.old Thu Sep 22 16:43:20 1994
--- agent/pl/parse.pl Thu Sep 22 16:43:20 1994
***************
*** 1,4 ****
! ;# $Id: parse.pl,v 3.0.1.2 1994/07/01 15:04:02 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 1,4 ----
! ;# $Id: parse.pl,v 3.0.1.3 1994/09/22 14:33:38 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 9,14 ****
--- 9,17 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: parse.pl,v $
+ ;# Revision 3.0.1.3 1994/09/22 14:33:38 ram
+ ;# patch12: builtins handled in &run_builtins to allow re-entrance
+ ;#
;# Revision 3.0.1.2 1994/07/01 15:04:02 ram
;# patch8: now systematically escape leading From if fromall is ON
;#
***************
*** 37,43 ****
local($fd) = STDIN; # Where does the mail come from ?
local($value); # Value of current field line
local($_);
! undef %Header; # Reset the all structure holding message
if ($file_name ne '') { # Mail spooled in a file
unless(open(MAIL, $file_name)) {
--- 40,46 ----
local($fd) = STDIN; # Where does the mail come from ?
local($value); # Value of current field line
local($_);
! undef %Header; # Reset the whole structure holding message
if ($file_name ne '') { # Mail spooled in a file
unless(open(MAIL, $file_name)) {
***************
*** 102,113 ****
s/^From(\s)/>From$1/ if $last_was_nl && $cf'fromesc =~ /on/i;
$last_was_nl = /^$/ || $cf'fromall =~ /on/i;
$Header{'Body'} .= $_;
- chop;
- # Deal with builtin commands
- if (s/^@(\w+)\s*//) { # A builtin command ?
- local($subroutine) = $Builtin{$1};
- &$subroutine($_) if $subroutine;
- }
}
}
close MAIL if $file_name ne '';
--- 105,110 ----
Index: agent/pl/newcmd.pl
Prereq: 3.0
*** agent/pl/newcmd.pl.old Thu Sep 22 16:43:17 1994
--- agent/pl/newcmd.pl Thu Sep 22 16:43:17 1994
***************
*** 1,4 ****
! ;# $Id: newcmd.pl,v 3.0 1993/11/29 13:49:03 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
--- 1,4 ----
! ;# $Id: newcmd.pl,v 3.0.1.1 1994/09/22 14:28:06 ram Exp $
;#
;# Copyright (c) 1990-1993, Raphael Manfredi
;#
***************
*** 9,14 ****
--- 9,18 ----
;# of the source tree for mailagent 3.0.
;#
;# $Log: newcmd.pl,v $
+ ;# Revision 3.0.1.1 1994/09/22 14:28:06 ram
+ ;# patch12: ensures the newcmd file is secure
+ ;# patch12: propagates glob for folder_saved
+ ;#
;# Revision 3.0 1993/11/29 13:49:03 ram
;# Baseline for mailagent 3.0 netwide release.
;#
***************
*** 90,95 ****
--- 94,104 ----
if $'loglvl > 1;
next; # Skip invalid command
}
+ unless (&'file_secure($path, "user command $cmd")) {
+ &'add_log("ERROR command '$cmd' is not secure")
+ if $'loglvl > 1;
+ next; # Skip unsecure command
+ }
# Load command into data structures by setting internal tables
$'Filter{$cmd} = "newcmd'run"; # Main dispatcher for new commands
$Usercmd{$cmd} = $path; # Record command path
***************
*** 117,122 ****
--- 126,132 ----
local($cmd_name) = $'cmd_name; # Command name (read only)
local($mfile) = $'mfile; # File name (read only)
local(*ever_saved) = *'ever_saved; # Saving already occurred?
+ local(*folder_saved) = *'folder_saved; # Last folder saved to
local(*cont) = *'cont; # Continuation status
local(*vacation) = *'vacation; # Vacation message allowed?
local(*lastcmd) = *'lastcmd; # Last failure status stored
*** End of Patch 15 ***
exit 0 # Just in case...