;# $Id: newcmd.pl,v 3.0.1.2 1995/01/03 18:12:58 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: newcmd.pl,v $
;# Revision 3.0.1.2 1995/01/03 18:12:58 ram
;# patch24: it is no longer possible to get at the vacation variable
;#
;# 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.
;#
;#
;# This package handles the dynamic loading of a perl script in memory,
;# providing a dynamic way of enhancing the command set of the mailagent.
;#
;# New commands are specified in the newcmd file specified in the config file.
;# The syntax of this file is the following:
;#
;# <cmd_name> <path> <function> [<status_flag> [<seen_flag>]]
;#
;# cmd_name: this is the command name, eg. RETURN_SENDER
;# path: this is the path to the perl script implementing the command.
;# function: the perl function within the script which implements the command
;# status_flag: states whether the command modifies the execution status
;# seen_flag: states whether the command is allowed in _SEEN_ mode
;#
;# The last two booleans are optional, and may be specified as either 'yes'
;# and 'no' or 'true' and 'false'. Their default value is respectively true
;# and false.
;#
;# New commands are loaded as they are used and put in a special newcmd
;# package, so that the names of the routines do not conflict with the
;# mailagent's one. They are free to use whatever function the mailagent
;# implements by prefixing the routine name with its package: normally, the
;# execution of the command is done from within the newcmd package.
;#
;# Commands are given a single argument: the string forming the command name.
;# Therefore, the command may implement the syntax it wishes. However, for
;# the user convenience, the special array @newcmd'argv is preset with a
;# shell-style parsed version. The mailagent also initializes the same
;# special variables as the one set for PERL commands, only does it put them
;# in the newcmd package instead of mailhook.
;#
;# Several data structures are maintained by this package:
;# %Usercmd, maps a command name to a file
;# %Loaded, records whether a file has been loaded or not
;# %Run, maps a command name to a perl function
;#
package newcmd;
#
# User-defined commands
#
# Parse the newcmd file and record all new commands in the mailagent data
# structures.
sub load {
return unless -s $cf'newcmd; # Empty or non-existent file
# Security checks. We cannot extend the mailagent commands if the file
# describing those new commands is not owned by the user or ir world
# writable. Indeed, someone could redefine default commands like LEAVE
# and use that to break into the user account.
return unless &'file_secure($cf'newcmd, 'new command');
unless (open(NEWCMD, $cf'newcmd)) {
&'add_log("ERROR cannot open $cf'newcmd: $!") if $'loglvl;
&'add_log("WARNING new commands not loaded") if $'loglvl > 5;
return;
}
local($home) = $cf'home;
$home =~ s/(\W)/\\$1/g; # Escape possible meta-characters like '+'
local($_);
local($cmd, $path, $function, $status, $seen);
while (<NEWCMD>) {
next if /^\s*#/; # Skip comments
next if /^\s*$/; # Skip blank lines
($cmd, $path, $function, $status, $seen) = split(' ');
$cmd =~ tr/a-z/A-Z/; # Cannonicalize to upper-case
$path =~ s/~/$cf'home/; # Perform ~ substitution
unless (-e $path && -r _) {
$path =~ s/^$home/~/;
&'add_log("ERROR command '$cmd' bound to unreadable file $path")
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
$Loaded{$path} = 0; # File not loaded yet
$Run{$cmd} = $function; # Perl function to call
$'Nostatus{$cmd} = 1 if $status =~ /^f|n/i;
$'Rfilter{$cmd} = 1 unless $seen =~ /^t|y/i;
&interface'add($cmd); # Add interface for perl hooks
$path =~ s/^$home/~/;
&'add_log("new command $cmd in $path (&$function)")
if $'loglvl > 18;
}
close NEWCMD;
}
# This is the main dispatcher for user-defined command.
# Our caller 'run_command' has set up some special variables, like $mfile
# and $cmd_name, which are used here. Someday, I'll have to encapsulate that
# in a better way--RAM.
sub run {
# Make global variables visible in this package. Variables which should
# not be changed are marked 'read only'.
local($cmd) = $'cmd; # Full command line (read only)
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(*lastcmd) = *'lastcmd; # Last failure status stored
local(*wmode) = *'wmode; # Filter mode
&'add_log("user-defined command $cmd_name") if $'loglvl > 15;
# Let's see if we already have loaded the perl script which is responsible
# for implementing this command.
local($path) = $Usercmd{$cmd_name};
unless ($path) {
&'add_log("ERROR unknown user-defined command $cmd_name") if $'loglvl;
return 1; # Command failed (should not happen)
}
local($function) = $Run{$cmd_name};
unless (&dynload'load('newcmd', $path, $function)) {
&'add_log("ERROR cannot load code for user-defined $cmd_name")
if $'loglvl;
return 1; # Command failed
}
# At this point, we know we have some code to call in order to run the
# user-defined command. Prepare the special array @ARGV and initialize
# the mailhook variable in the current package.
&hook'initvar('newcmd'); # Initialize convenience variables
local(@ARGV); # Argument vector for command
require 'shellwords.pl';
eval '@ARGV = &shellwords($cmd)';
# We don't need to protect the following execution within an eval, since
# we are currently inside one, via run_command.
local($failed) = &$function($cmd); # Call user-defined function
# Log our action
local($msg) = $failed ? "and failed" : "successfully";
&'add_log("ran $cmd_name [$mfile] $msg") if $'loglvl > 6;
$failed; # Propagate failure status
}
package main;