#!/usr/pkg/bin/perl
#
# Copyright (C) 1993-2003 Ken'ichi Fukamachi
#          All rights reserved. 
#               1993-1996 fukachan@phys.titech.ac.jp
#               1996-2003 fukachan@sapporo.iij.ad.jp
# 
# FML is free software; you can redistribute it and/or modify
# it under the terms of GNU General Public License.
# See the file COPYING for more details.
#
# $FML: makefml,v 2.210.2.14 2003/01/25 05:58:25 fukachan Exp $
#

### AUTOMATICALLY REPLACED by makefml (Fri, 14 Mar 2025 14:57:10 )
$CONFIG_DIR = '/usr/pkg/fml/.fml'; # __MAKEFML_AUTO_REPLACED_HERE__

&InitTTY;
&InitMakeFml;

# info
if ($IN_CHANNEL eq 'stdin') {
    @ARGV = split(/\s+/, <STDIN>);
}
elsif (! @ARGV) { 
    # &ExecCmd("info");
    $opt_w ? &MenuInputLoop : &ExecCmd("info");
    exit 0;
}

if (@ARGV) {
    &ExecCmd(join(" ",@ARGV));
}
else {
    &ExecCmd("info");
}
# unlocked here (in ExecCmd).

if ($GroupWritable) {
    print STDERR "\n   Please check the group permission in $ML_DIR\n";
}

# last message
if ($SavedFP eq 'install') {
    print STDERR "\n -- Enjoy Internetworking!\n";
}

# XXX this code works only when "makefml test" runs.
if ($Env eq 'CUI') {
    &System if $SYSTEM_ARGV || $SYSTEM_ARGV_IN || $SYSTEM_ARGV_OUT;
}

&FlushLog;

if ($opt_E eq 'HTTPD') {
    print "\n";
    print $WStatus;
    print "ExitStatus: $XStatus\n";
    print "\n";
}
exit 0;


#################### LIBLARIES ####################
sub __system
{
    my(@buf) = @_;

    if ($Env eq 'CUI') {
	print STDERR "__system(@buf)\n" if $debug0;
	system @buf;
    }
    else {
	&Error("do not run system(3) not on shell");
    }
}

sub System 
{
    local($cmd);

    $| = 1;

    if ($SYSTEM_ARGV_IN) {
	open(SYS_IN,  "$SYSTEM_ARGV_IN|")   || &Die($!);
	open(SYS_OUT, "| $SYSTEM_ARGV_OUT") || &Die($!);
	select(SYS_OUT); $| = 1; select(STDOUT);

	while (<SYS_IN>) { print SYS_OUT $_;}

	if ($SYSTEM_ARGV_QUERY_INPUT) {
	    sleep 1;
	    print STDERR "\n";
	    sleep 1;
	    print STDERR 
		"* Enter mailbody, end with \".\" on a line by itself\n";
	    while (1) {
		$cmd = &GetString;
		if ($cmd eq '.') { last;}
		print SYS_OUT "$cmd\n";
	    }
	}
	    
	close(SYS_IN);
	close(SYS_OUT);
    }

    system $SYSTEM_ARGV if $SYSTEM_ARGV;
}


sub InitMakeFml
{
    local($pwd);
    if ($ENV{'OS'} =~ /Windows_NT/) {
	eval(' chop ($pwd = `cd`); ');
	print "pwd = $pwd\n" if $debug_nt;
    }
    else {
	eval(' chop ($pwd = `pwd`); ');
    }

    # flush;
    select(STDOUT); $| = 1;

    &GetTime(time);

    ### signal handling
    $SIG{'ALRM'} = 'TimeOut';
    $SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = 'SignalLog';

    # architecture default
    $UNISTD = $HAS_ALARM = $HAS_GETPWUID = $HAS_GETPWGID = 1;

    ### getopt
    if ($ENV{'MAKEFML'}) {
	unshift(@ARGV, split(/\s+/, $ENV{'MAKEFML'}));
    }
    require 'getopts.pl';
    &Getopts("adhf:A:O:p:D:vwV:mi:u:UFE:W:c:");

    # toggle flags
    # $CGIInstallMode = ($opt_W =~ /cgi/i) ? 1 : 0;
    $CGIInstallMode = 1; # yes always! :-)
    $AutoLoad       = $opt_a ? 1 : 0;
    $debug          = $opt_d;
    $verbose        = $opt_v;
    $MailNotify     = $opt_m;
    $EnForceMode    = $opt_F ? 1 : 0;

    # import variables
    $Env         = $opt_E || 'CUI';
    $HOME        = $ENV{'HOME'};
    $PWD         = $ENV{'PWD'} || $pwd || '.'; # '.' is the last resort;)
    $COMPAT_ARCH = $opt_A;
    $VENDOR      = $opt_V;
    $IN_CHANNEL  = $opt_i;

    # special aliases
    if ($ARGV[0] =~ /^install\-withcgi/) {
	$CGIInstallMode = 1;
	$ARGV[0] = 'install'; # fml-support: 7706
    }

    ### determine Architechure dependence
    if ($ENV{'OS'} =~ /Windows_NT/) {
	$COMPAT_ARCH  = "WINDOWS_NT4";
	$COMPAT_WIN32 = 1;
	$CPU_TYPE_MANUFACTURER_OS = "unknown-unknown-windowsnt4";
    }
   
    # umask 077?
    # if a group mainteints the fml system, umask(007)?;
    # here several people can read but not write;
    umask(002);

    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	# first time if !-d $EXEC_DIR ? (must be true)
	# XXX perl (< 5.6.0) returns false " if -d '' ", off course !? 
	# XXX perl 5.6.0 returns true " if -d '' "! correct??? 
	if ($EXEC_DIR) {
	    require "$EXEC_DIR/sys/$COMPAT_ARCH/depend.pl" if -d $EXEC_DIR;
	}
	$USER = $ENV{'USERNAME'};
    }
    else {
	$USER = $ENV{'USER'} || (getpwuid($<))[0];
    }

    # overwrite (used in libexec/mead.pl)
    $USER        = $opt_u || $USER;

    { # DNS AutoConfigure to set FQDN and DOMAINNAME; 
	local(@n, $hostname, $list);
	if ($ENV{'HOSTNAME'}) {
	    $FQDN = $ENV{'HOSTNAME'};
	    $DOMAINNAME = $FQDN;
	    $DOMAINNAME =~  s/^[^\.]+\.//;
	} else {
	chop($hostname = `hostname`); # beth or beth.domain may be possible
	$FQDN = $hostname;
	@n    = (gethostbyname($hostname))[0,1]; $list .= " @n ";
	@n    = split(/\./, $hostname); $hostname = $n[0]; # beth.dom -> beth
	@n    = (gethostbyname($hostname))[0,1]; $list .= " @n ";

	foreach (split(/\s+/, $list)) { /^$hostname\.\w+/ && ($FQDN = $_);}
	$FQDN       =~ s/\.$//; # for e.g. NWS3865
	$DOMAINNAME = $FQDN;
	$DOMAINNAME =~ s/^$hostname\.//;
	}

	$Config'FQDN = $FQDN; #';
    }

    &ProbePerlVersion;
    if ($UnderJPerl) {
	local($sep) = "*" x 60;
	local($tab) = "\t\t";
	print STDERR "\n$sep\n";
	print STDERR "\n${tab}***** WARNING *****\n";
	print STDERR "${tab}YOUR PERL LOOKS jperl! (looks $JPerlMode mode)\n";
	print STDERR "${tab}YOU SHOULD USE\n";
	print STDERR "${tab}perl 4.036 or perl 5\n${tab}NOT jperl!\n";

	&InitTTY;
	$r = &Query("YOU USE fml under jperl?", "y/n", "y|n", "n");

	if ($r eq 'y') {
	    print STDERR "\nHmm... YOU MAY HAVE PROBLEMS.\n";
	    print STDERR "ALL IS DONE UNDER YOUR OWN RISK\n";
	    print STDERR "PLEASE DO NOT ASK fml-* ML's ON PROBLEMS\n\n";
	    sleep 3;
	}
	else {
	    print STDERR "O.K. Please install usual perl. Good Luck!\n";
	    print STDERR "makefml ends here.\n\n";
	    exit 0;
	}
    }

    # architecture dependence;
    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	$CONFIG_DIR =~ s#\\#/#g;

	# Architecture Dependence (import fml.pl);
	$UNISTD = $HAS_ALARM = $HAS_GETPWUID = $HAS_GETPWGID = 0;
    }

    # XXX important to reset when $ARGV[0] eq 'install'
    # XXX and even if $CONFIG_DIR is defined in 'install'
    # XXX We should ignore $CONFIG_DIR in 'install' since it may be twice time.
    # Anyway try once ... (may be re-installation ?) Dame moto sune:-)
    if ((! $CONFIG_DIR) || ($ARGV[0] eq 'install')) {
	$CONFIG_DIR = "/usr/pkg/fml/.fml";
    }

    if (($ARGV[0] =~ /^install/i) && -d 'src') {
	unshift(@INC, "$PWD/src");
	print STDERR "unshift(\@INC, $ENV{'PWD'}/src)\n";
    }

    ### FIX VARIABLES
    $CONFIG_DIR = $opt_D || $CONFIG_DIR || "$HOME/.fml";
    $FML_POLICY = $opt_p || "$CONFIG_DIR/policy";
    $CGI_CONFIG = $opt_c || "$CONFIG_DIR/cgi.conf";

    # in default, disable to load .fml/system in 'make install'
    if ($ARGV[0] eq 'install') {
	$FML_CONFIG = $opt_f || "$CONFIG_DIR/system" if $AutoLoad || $opt_f;
    }
    else {
	$FML_CONFIG = $opt_f || "$CONFIG_DIR/system";
    }

    # config amd temporary files
    if ($TheFirstTime) {
	$MAKEFML_LOGFILE  = "/tmp/fml::makefml::log.${USER}.$$";
	$TempolaryLogfile = $MAKEFML_LOGFILE;
    }
    else {
	$MAKEFML_LOGFILE  = "$CONFIG_DIR/log";
    }
    &Touch($MAKEFML_LOGFILE) unless -f $MAKEFML_LOGFILE;


    ### *Config, %Default, %PolicyDefault;
    ###   REQUIRED HERE BEFORE LOADING;
    &SetHashDefaults;

    # not lock in install
    $NOT_LOCK{$ARGV[0]} = 1 if $opt_U;


    ### LOADING $FML_POLICY
    if (-f $FML_POLICY) {
	# print STDERR "---Load POLICY from $FML_POLICY\n";
	&GetCurPolicy;
    }

    ### LOADING $FML_CONFIG
    if (-f $FML_CONFIG) {
	print STDERR "---Loading the configuration file $FML_CONFIG\n"
	    if $debug0;

	package Config;
	eval("require \$main'FML_CONFIG;\#'");
	&main'Warn($@) if $@; #';

	$main'debug = $Config'debug;
	package main;

	# overwrite configuration debug mode;
	$debug = 1 if $opt_d;

	&Dumpvar('Config') if $debug;
    }
    else {
	$TheFirstTime = 1;
	print STDERR "---NOT USING configuration file (for the first time)\n";
    }

    # cached
    $CPU_TYPE_MANUFACTURER_OS = $Config'CPU_TYPE_MANUFACTURER_OS{$FQDN}; #';

    # use os type cache
    if ($UNISTD && $CPU_TYPE_MANUFACTURER_OS && $ARGV[0] ne 'install') {
	$CACHED_YES = 1;
    } 
    # inspecting cpu-type-manufacturer-operating-system
    elsif ($UNISTD) {
	if ($ARGV[0] eq 'install') {
	    $CACHED_YES = 0; # SHOULD CHECK system by config.guess
	}
	elsif ($CPU_TYPE_MANUFACTURER_OS) {
	    $CACHED_YES = 1;
	}

	local($eval, $dir, $guess);

	$dir = $0;
	$dir = $dir =~ m#/# ? $dir : "./$dir";
	$dir =~ s#(.*)/.*#$1#;

	if (-f "$dir/sbin/config.guess") {
	    $guess = "$dir/sbin/config.guess";
	}
	elsif (-f "$CONFIG_DIR/../sbin/config.guess") {
	    $guess = "$CONFIG_DIR/../sbin/config.guess";
	}

	if (! $guess) { 
	    print STDERR "ERROR: config.guess NOT FOUND!\n";
	    print STDERR "       Please validate your source.\n\n";
	    exit 1;
	}

	$eval = qq#\$CPU_TYPE_MANUFACTURER_OS = `sh $guess`;#;

	print STDERR "$eval\n" if $debug;
	eval($eval);
	&main'Warn($@) if $@; #';

	chop($CPU_TYPE_MANUFACTURER_OS);

	# else
	if ($CPU_TYPE_MANUFACTURER_OS) {
	    # import OS_TYPE to %Config is done later (why?)
	    &DefineCMO($FQDN, $CPU_TYPE_MANUFACTURER_OS, 1);
	}
	else {
	    print STDERR 
		"   Hmm... inspecting your system by config.guess failed?\n";
	}
    }
    else {
	if ($CPU_TYPE_MANUFACTURER_OS) {
	    &DefineCMO($FQDN, $CPU_TYPE_MANUFACTURER_OS, 1);
	}
    }

OS_TYPE:

    print &Dumpvar('Config') if $debug;

    ### Now we check 'struct sockaddr' only when needed
    ### &SetSockAddr($CPU_TYPE_MANUFACTURER_OS); # require OS_TYPE;

    if ($Config'OS_TYPE{$FQDN}) { #';
	$OS_TYPE = $Config'OS_TYPE{$FQDN} || $OS_TYPE; #';
    }
    else {
	print STDERR "\$Config'OS_TYPE{'$FQDN'} = '$OS_TYPE';\n" if $debug;
	&DefineCMO($FQDN, $CPU_TYPE_MANUFACTURER_OS);
    }
    
    # if not defined this machine OS;
    local($cached_cmo) = $Config'CPU_TYPE_MANUFACTURER_OS{$FQDN}; #';
    if ($opt_O) {
	$CPU_TYPE_MANUFACTURER_OS = $opt_O;
	&DefineCMO($FQDN, $CPU_TYPE_MANUFACTURER_OS);
	print "   YOU DEFINED\n";
	print "   THIS HOST ($FQDN) IS [$CPU_TYPE_MANUFACTURER_OS]\n";
	print "   THIS HOST ($FQDN) OS [$OS_TYPE]\n" if $debug;
    }
    elsif ($CPU_TYPE_MANUFACTURER_OS && $CACHED_YES) {
	if ($debug0) {
	    print "\n";
	    print "   THIS HOST ($FQDN) IS [$CPU_TYPE_MANUFACTURER_OS] (cached)\n";
	    print "   THIS HOST ($FQDN) OS [$OS_TYPE]\n" if $debug;
	    print "\n";
	}
    }
    elsif ($CPU_TYPE_MANUFACTURER_OS) {
	print "\n";
	print "   THIS HOST ($FQDN) IS [$CPU_TYPE_MANUFACTURER_OS]\n";
	print "   THIS HOST ($FQDN) OS [$OS_TYPE]\n" if $debug;
	print "\n";
    }
    elsif ($cached_cmo) { 
	$CPU_TYPE_MANUFACTURER_OS = $cached_cmo;
	$OS_TYPE = $Config'OS_TYPE{$FQDN}; #'; 
	print "\n";
	print "   THIS HOST ($FQDN) IS [$CPU_TYPE_MANUFACTURER_OS] (cached)\n";
	print "   THIS HOST ($FQDN) OS [$OS_TYPE] (cached)\n" if $debug;
	print "\n";
    }
    elsif ($COMPAT_ARCH eq "WINDOWS_NT4") {
	$OS_TYPE = "WINDOWS_NT4";
	eval("\$Config'OS_TYPE{'$FQDN'} = '$OS_TYPE';");
	&main'Warn($@) if $@; #';
    }
    else {
	# print "---Try to inspect your Operating System ...\n";

	$CPU_TYPE_MANUFACTURER_OS = "unknown-unknown-unknown";
	&DefineCMO($FQDN, $CPU_TYPE_MANUFACTURER_OS);

	print "   I failed to inspect your system.\n";
	print "   THIS HOST ($FQDN) IS [$CPU_TYPE_MANUFACTURER_OS]\n";
	print "   THIS HOST ($FQDN) OS [$OS_TYPE]\n" if $debug;
	print "\n";

	print "   PLEASE DEFINE \$CPU_TYPE_MANUFACTURER_OS IF POSSIBLE\n";
	print "   If you cannot define \$CPU_TYPE_MANUFACTURER_OS\n";
	print "   FML may work with \"$CPU_TYPE_MANUFACTURER_OS\"\n";
	print "   (I assume BSD like if \"$CPU_TYPE_MANUFACTURER_OS\")\n";
	print "   cpu-manufacturer-os [$CPU_TYPE_MANUFACTURER_OS] ";
	$cmd = &GetString;
	$cmd = ($cmd !~ /^\s*$/) ? $cmd : $v;
	print "\n";

	$CPU_TYPE_MANUFACTURER_OS = $cmd ? $cmd : "unknown-unknown-unknown";
	&DefineCMO($FQDN, $CPU_TYPE_MANUFACTURER_OS);
	print "   THIS HOST ($FQDN) IS [$CPU_TYPE_MANUFACTURER_OS]\n";
	print "   THIS HOST ($FQDN) OS [$OS_TYPE]\n" if $debug;
	print "\n";
    }

    # vendor info (e.g. used when MetaInfo on NT4)
    if ($VENDOR) {
	eval("\$Config'VENDOR = '$VENDOR';");
	&main'Warn($@) if $@; #';
    }

    ### anyway reload and set the present config for convenience;
    &GetCurConfig;
    &ResetVariables;

    # fix include path for *.pl 
    push(@INC, $EXEC_DIR);

    # for .pm
    push(@INC, "$EXEC_DIR/module/fml-devel");

    if ($CurConfig{'PERSONAL_OR_GROUP'} =~ /^(group|fmlserv)$/) {
	$GroupWritable = $CurConfig{'PERSONAL_OR_GROUP'};
    }

    # 3.0B
    $DefaultConfigPH = "$EXEC_DIR/default_config.ph"
	if -f "$EXEC_DIR/default_config.ph";
}

# CFVersion: 2
#    OS_TYPE
#    OS_TYPE is used in the age of "CFVersion 2".
# CFVersion: 3
#    CPU_TYPE_MANUFACTURER_OS
#    This is the current parameter geussed by config.guess (GNU autoconf).
sub DefineCMO
{
    local($fqdn, $cmo, $no_set_os_type) = @_;

    $Config'CPU_TYPE_MANUFACTURER_OS{$fqdn} = $CPU_TYPE_MANUFACTURER_OS ;#';

    # special case
    return if $no_set_os_type;

    $OS_TYPE = (split(/\-/, $CPU_TYPE_MANUFACTURER_OS))[2];
    $OS_TYPE =~ tr/a-z/A-Z/;

    print STDERR "\$Config'OS_TYPE{'$fqdn'} = '$OS_TYPE';\n" if $debug;
    eval("\$Config'OS_TYPE{'$fqdn'} = '$OS_TYPE';");
    &main'Warn($@) if $@; #';
}


sub SetHashDefaults
{
    # configurable variables;
    @Config = ('DOMAIN', 'FQDN', 'EXEC_DIR', 'ML_DIR');

    %Config = ('EXEC_DIR', 'EXEC FILES DIRECTORY',
	       'ML_DIR',   'TOP LEVEL ML DIRECTORY', 
	       'DOMAIN',   'DOMAIN NAME', 
	       'FQDN',     'FQDN', 
	       ); 

    %Default = ('PERSONAL_OR_GROUP', 'personal',
		'EXEC_DIR', '/usr/pkg/fml',
		'ML_DIR',   '/var/fml', 
		'DOMAIN',   $DOMAINNAME,
		'FQDN',     $FQDN,
		'GROUP',    '',
		'LANGUAGE', $LANGUAGE,
		'VENDOR',   '',
		'TZ',       '+0900',
		'CGI_PATH', '/cgi-bin/fml',
		); 

    %PolicyDefault = 
	('MAIL_LIST_MODE',         'listname (distribute+commands)',
	 'CONTROL_ADDRESS_FORMAT', 'listname-ctl (command only)',
	 ); 


    # $COMPAT_ARCH eq "WINDOWS_NT4"
    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	local($dir);
	chop($dir = `cd`);
	$dir =~ s/(\w:).*/$1/;
	$Default{'EXEC_DIR'} = "$dir\\fml";
	$Default{'ML_DIR'}   = "$dir\\fml\\ml";
    }

    # If you customize "makefml pgp" command, run in the following way
    # % env MAKEFML_PGP_DEFAULT_MODE=dist-encrypt makefml elena::pgp ...
    my ($pgp_compat_mode) = $ENV{'MAKEFML_PGP_DEFAULT_MODE'} || 'admin-auth';
    %MakeFmlProcAlias = (
			 # fml 4.0
			 'da' => 'dist-auth',     
			 'de' => 'dist-encrypt',  
			 'aa' => 'admin-auth',    
			 'ae' => 'admin-encrypt',

			 # compatible with fml 3.0
			 'pgp'  => "$pgp_compat_mode.pgp",
			 'pgp2' => "$pgp_compat_mode.pgp2",
			 'pgp5' => "$pgp_compat_mode.pgp5",
			 'pgpk' => "$pgp_compat_mode.pgpk",
			 'pgps' => "$pgp_compat_mode.pgps",
			 'pgpe' => "$pgp_compat_mode.pgpe",
			 'pgpv' => "$pgp_compat_mode.pgpv",
			 );

    %MakeFmlProc = ('install',  'do_install',
		    '0#install', 'Install the fml system',
		    'info',     'do_info',
		    '0#info',    'show this message',
		    'setq',     'do_setq',
		    'show',     'do_show',

		    'config',   'do_config',
		    '5001#config ML', '[menu] to configure <ML> fundamental',
		    'edit',   'do_edit',
		    '5000#edit ML', "edit <ML>'s file under lock (default config.ph)",

		    'new',      'do_newml',
		    'newml',    'do_newml',
		    '10#newml ML',   'make a new Mailing List <ML>',

		    'destructml',     'do_destructml',
		    '10#destructml ML', 'destruct Mailing List <ML>',

		    # admin command (main)
		    'add',      'do_adduser',
		    '20#add ML addr',     'add <addr> to <ML>',
		    'adduser',  'do_adduser',
		    # '20#adduser ML addr', 'add <addr> to <ML>',
		    'bye',      'do_byeuser',
		    '30#bye ML addr',     'remove <addr> from <ML>',
		    'byeuser',  'do_byeuser',
		    # '30#byeuser ML addr', 'remove <addr> from <ML>',

		    # asymmetric registration
		    'addmember',      'do_addmembers',
		    'addmembers',     'do_addmembers',
		    'add2member',     'do_addmembers',
		    'add2members',    'do_addmembers',
		    '33#add2members ML addr', 'add <addr> to only members',
		    'addactive',      'do_addactives',
		    'addactives',     'do_addactives',
		    'add2active',     'do_addactives',
		    'add2actives',    'do_addactives',
		    '33#add2actives ML addr', 'add <addr> to only actives',

		    # admin command (sub)
		    'on',     'do_on',
		    'off',    'do_off',
		    'skip',   'do_off',
		    'chaddr', 'do_chaddr',
		    'matome', 'do_matome',
		    'digest', 'do_digest',
		    '40#on  ML addr', 'on  <addr>',
		    '40#off ML addr', 'off <addr>',
		    '45#chaddr ML old new', 'change address <old> => <new>',
		    '48#matome ML addr [opt]', 'set up digest(matome) for address <addr>',
		    '48#digest ML addr [opt]', 'set up digest(matome) for address <addr>',

		    'addadmin', 'do_addadmin',
		    '60#addadmin ML addr', 'add <addr> as an admin to <ML>',
		    'byeadmin', 'do_byeadmin',
		    '60#byeadmin ML addr', 'remove the administrator of <ML>',

		    'help',	'do_info',
		    '80#help',	'help message',
		    'passwd',	'do_passwd',
		    '80#passwd ML addr',	'to change the administrator passwd',

		    'test',	'do_test',
		    '80#test ML',	'test ',

		    'fmlserv',  'do_fmlserv',
		    'listserv', 'do_fmlserv',
		    'majordomo','do_fmlserv',
		    '100#fmlserv', 'set up fmlserv (listserv-like server)',
		    # '100#listserv','set up fmlserv (listserv-like server)',
		    # '100#majordomo','set up fmlserv (listserv-like server)',

		    # mead
		    'mead',    'do_mead',
		    '99#mead', 'set up mead (error mail analyzer)',


		    # NT extension
		    'popfml',     'do_popfml',
		    'pop_passwd', 'do_pop_passwd',

		    # fml 4.0 new asymmetric key encryptions
		    'dist-auth',     'do_dist_auth',
		    'dist-encrypt',  'do_dist_encrypt',
		    'admin-auth',    'do_admin_auth',
		    'admin-encrypt', 'do_admin_encrypt',
		    '91#dist-auth.pgp ML args'     => '(abbr. da.pgp) pgp = pgp2 pgp[5kesv] gpg',
		    '91#dist-encrypt.pgp ML args'  => '(abbr. de.pgp) pgp = pgp2 pgp[5kesv] gpg',
		    '91#admin-auth.pgp ML args'    => '(abbr. aa.pgp) pgp = pgp2 pgp[5kesv] gpg',
		    '91#admin-encrypt.pgp ML args' => '(abbr. ae.pgp) pgp = pgp2 pgp[5kesv] gppg',


		    # PGP 2
		    'pgp',	'do_pgp2',
		    'pgp2',	'do_pgp2',
		    '90#pgp ML args' => 'e.g. admin-auth.pgp2 ML -ka pubkey',

		    # PGP 5
		    'pgpk',	'do_pgpk',
		    'pgps',	'do_pgps',
		    'pgpe',	'do_pgpe',
		    'pgpv',	'do_pgpv',

		    'delivery_mode',  'do_delivery_mode',

		    # misc
		    'lock', 'do_lock',
		    '110#lock ML [time]', 'lock <ML> for <time> (default 3600) sec.',

		    # extension/special
		    'qmail-setup', 'do_qmail_setup',

		    # edit $EXEC_DIR/drafts/* $EXEC_DIR/etc/makefml/cf
		    'edit-template',   'do_edit_template',
		    '200#edit-template', 'edit template file under locked state',
		    'config-template', 'do_config_template',
		    '200#config-template', 'configure template cf file',

		    'command', 'do_command',
		    '1000#command ML addr ...', 'e.g. "command ML <addr> mget last:3 mp"',

		    # create document templates
		    'create-doc-template',    'do_create_doc_template',
		    '300#create-doc-template ML', 'create document templates e.g. help, guide',

		    # conversion
		    'conv',             'do_conv',
		    'update',           'do_update',
		    'update-config.ph', 'do_update_config_ph',
		    'update-config',    'do_update_config_ph',
		    'config-update',    'do_update_config_ph',
		    '400#update-config ML', 'make config.ph (cf -> config_ph)',

		    # upgrade from 2.x to 3.0
		    'upgrade', 'do_upgrade',

		    # WWW/CGI interface for cgi interface
		    # (hidden function only CGI uses)
		    'html_config',          'do_html_config',
		    'html_config_set',      'do_html_config',
		    'html_passwd',          'do_html_passwd',
		    'html_cgiadmin_passwd', 'do_html_cgiadmin_htpasswd',

		    # cgi utilities
		    'admin.cgi',          'do_setup_admin_cgi_init',
		    'mladmin.cgi',        'do_setup_mladmin_cgi_init',
		    'ml-admin.cgi',       'do_setup_mladmin_cgi_init',
		    '500#mladmin.cgi ML', 'set up ml-admin/$ml/*.cgi',

		    # cui htpasswd wrapper
		    'htpasswd',           'do_htpasswd',
		    '500#htpasswd ML',    'htpasswd wrapper for ml',

		    # utilities
		    'resend',       'do_resend',
		    'log',          'do_log',
		    'tail',         'do_log',
		    '1000#log ML [opt]',  'show log: [-i] [-NUMBER] [all] [-pPATTERN]',
		    '1000#tail ML [opt]',  'syntax sugar of log',

		    'showconfig',          'do_showconfig',
		    '8000#showconf',       'show environment, version, ..',
		    'showconf',            'do_showconfig',
		    'send-pr',             'do_send_pr',
		    'bug-report-template', 'do_send_pr',

		    # update /var/spool/ml/etc/aliases
		    'recollect-aliases',   'do_collect_aliases',
		    '401#recollect-aliases', 'remake $ML_DIR/etc/aliases',
		    );

    # functions not to lock
    %NOT_LOCK = ('newml', 1,
		 'info', 1,
		 'help', 1,
		 'listserv', 1,
		 'majorodomo', 1,
		 'fmlserv', 1,
		 'mead', 1,
		 'command', 1,
		 'edit-template', 1,
		 'config-template', 1,

		 # CGI/
		 'html_config', 1,
		 'admin.cgi',   1,
		 'mladmin.cgi', 1,

		 # utilities
		 'resend', 1,
		 'log',    1,
		 'showconfig', 1,
		 'showconf', 1,
		 'show', 1,
		 'send-pr', 1,
		 'bug-report-template', 1,
		 'recollect-aliases', 1,
		 );

    # <ML> argument is not required.
    @NOT_REQUIRE_ML_ARG = 
	(
	 "newml", "info", "help", "install", 
	 "fmlserv", "majordomo", "listserv", "popfml",
	 "edit-template", "config-template",
	 "mead",

	 # CGI/
	 "admin.cgi", "html_cgiadmin_passwd",
	 'admin.cgi-config', 'admin.cgi_config',

	 # utility
	 "show", "showconfig", "showconf", 'send-pr', 'bug-report-template',
	 "recollect-aliases"
	 );
}


sub InitFmlConfig
{
    local($cmd, $prompt, $v, $go_flag);

    print "---Please Define Your Fml System Configurations\n\n";

    # -f file case
    if (-f $opt_f && -f $FML_CONFIG) {
	print STDERR "O.K. installing by using $FML_CONFIG\n";
	$go_flag = 1;
    }
    # STANDARD
    else {

	# personal or group-shared?
	printf "%-25s ", 
	"Personal Use or ML-Admin-Group-Shared or fmlserv you use?";

	$cmd = &Query("Personal, Group, Fmlserv", "personal/group/fmlserv", 
		      "personal|group|fmlserv", "personal", 1);    
	$cmd = ($cmd !~ /^\s*$/) ? $cmd : $v;
	&do_setq("PERSONAL_OR_GROUP", $cmd);

	if ($cmd eq 'group' || $cmd eq 'fmlserv') {
	    printf "Please define the group (in /etc/group) ML Operators use";
	    $cmd = &Query("Group of Mailing List Operators", 
			  "fml or GID ([\\w\\d]+)", "[\\w\\d]+", "fml", 1);    
	    &do_setq("GROUP", $cmd);

	    $GID = &GetGID($cmd);

	    print "GID\t$cmd\n" if $debug;
	    print "GID\t$GID\n" if $debug;

	    if (! $GID) {
		print "   *** ERROR ***\n";
		print "   I cannot find the group \"$cmd\" in /etc/group.\n";
		print "   Please define it!\n";
		exit 0;
	    }
	}


	# values;
	$buf .= sprintf("  %10s\n", "--- summary ---");
	local($pat, $k, $v);
	for (@Config) {
	    $k = $_;
	    $p = $Config{$_};
	    $v = $CurConfig{$_} ? $CurConfig{$_} : $Default{$_};

	    printf "%-25s %s ", $p, "[$v]";
	    $cmd = $v;
	    $buf .= sprintf("  %10s: %s\n", $k, $cmd);
	    &do_setq($k, $cmd);
	}

	# Language Extension for documents;
	$deflang  = $FQDN =~ /jp$/i ? "Japanese" : "English";

	$cmd = &Query("Language", 
		      "Japanese or English", "Japanese|English", $deflang, 1);

	&do_setq("LANGUAGE", $cmd);
	$buf .= sprintf("  %10s: %s\n", "Language", $cmd);

	# Time Zone
	$cmd = &Query("TimeZone", 
		      "TZ: e.g. +0900, -0300", '[\-+]\d{4}', &ProbeTZ, 1);

	&do_setq("TZ", $cmd);
	$buf .= sprintf("  %10s: %s\n", "TimeZone", $cmd);

	print "\n$buf\n";

    }

    ### installation main phase ###
    &GetCurConfig;

    if ($go_flag) {
	print "-" x 60; print "\n";
	for (@Config, "LANGUAGE", "TZ") {
	    printf "\t%-10s   %s\n", $_, $CurConfig{$_};
	}
	print "-" x 60; print "\n";
    }

    # print "CONFIG_DIR (e.g. $HOME/.fml, $CurConfig{'EXEC_DIR'}/.fml ...)\n";
    # print "Config Saved in [$CurConfig{'EXEC_DIR'}/.fml] ";
    # $cmd = &GetString;
    # $cmd = ($cmd !~ /^\s*$/) ? $cmd : "$CurConfig{'EXEC_DIR'}/.fml";
    # $CONFIG_DIR = $cmd;

    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	$CONFIG_DIR = "$CurConfig{'EXEC_DIR'}/_fml";
    }
    else {
	$CONFIG_DIR = "$CurConfig{'EXEC_DIR'}/.fml";
    }

    # mkdir CONFIG_DIR;
    {
	local($dir);
	for (split(/\//, $CONFIG_DIR)) {
	    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
		$dir .= $dir ? "/$_" : $_;
	    }
	    else {
		$dir .= "/$_";
	    }

	    $dir =~ s#//#/#g;

	    # print "   mkdir $dir\n";
	    # here /usr/local/fml;only installer can read-write this;
	    # print STDERR "mkdir($dir, 0755);\n";
	    &Mkdir($dir, 0755); 
	}
    }

    # overwrite
    $FML_CONFIG = "$CONFIG_DIR/system";
    $CGI_CONFIG = "$CONFIG_DIR/cgi.conf";
    

    $buf = &Dumpvar('Config');
    &SaveConfig($buf) if $buf;

    print "\nThe current configuration is saved in $FML_CONFIG\n";
}


sub ProbeTZ
{
    local($flag, @x, @p);
    local($time) = 3931200;

    @x = gmtime($time);
    @p = localtime($time);

    if ($p[2] - $x[2] != 0) {
	$flag = ($p[2] - $x[2] > 0) ? "+" : "-";
    }
    # +0000 or [+-]0030 ?
    else {
	$flag = ($p[1] - $x[1] >= 0) ? "+" : "-";
    }

    sprintf("%1s%02d%02d", $flag, &ABS($p[2] - $x[2]), &ABS($p[1] - $x[1]));
}

sub ABS { $_[0] < 0 ? - $_[0] : $_[0];}


sub GetCurConfig
{
    local($s);

    # reset %CurConfig from Config Name Space;
    for (keys %Default) { 
	$s .= "\$CurConfig{'$_'} = \$Config'$_;\n";
    }

    eval($s);
    &main'Warn($@) if $@; #';
}


sub DestDir
{
    my($dir) = @_;
    my($destdir);
    $destdir = $ENV{'DESTDIR'};

    return ($destdir eq '')? $dir: ($destdir . $dir);
}

sub SaveConfig
{
    local($buf) = @_;
    local($config);

    $config = DestDir($FML_CONFIG);

    # /usr/local/fml/.fml/system (perl script: config for makefml)
    open(F, ">> $config") || &Die("Cannot save config to $FML_CONFIG($config)");
    select(F); $| = 1; select(STDOUT);
    print F $buf, "\n";
    print F "\n1;\n";
    close(F);

    # /usr/local/fml/.fml/system.sh (shell script: config for shell script)
    open(F, ">> ${config}.sh") || 
	&Die("Cannot save config to ${FML_CONFIG}.sh");
    select(F); $| = 1; select(STDOUT);
    print F "EXEC_DIR=$EXEC_DIR\n";
    print F "ML_DIR=$ML_DIR\n";
    close(F);
}


sub GetCurPolicy
{
    local($s);

    if (! -f $FML_POLICY) {
	&Touch($FML_POLICY);
	return;
    }

    package Policy;
    eval("do \$main'FML_POLICY;\#'");
    &main'Warn($@) if $@; #';
    package main;

    # reset %CurPolicy from Policy Name Space;
    for (keys %PolicyDefault) { 
	$s .= "\$Policy{'$_'} = \$Policy'$_;\n";
    }

    eval($s);
    &main'Warn($@) if $@; #';

    if ($debug) {
	print STDERR "---POLICY LOADING\n";
	while (($k, $v) =  each %Policy) {
	    printf STDERR "   debug:\$Policy %-20s -> %s\n", $k, $v;
	}
	print STDERR "---POLICY LOADING ENDS\n";
    }
}


sub SavePolicy
{
    local($buf) = @_;
    local($policy);

    $policy = DestDir($FML_POLICY);

    open(F, ">> $policy") || &Die("Cannot save POLICY to $policy");
    select(F); $| = 1; select(STDOUT);
    print F "$buf\n";
    print F "\n1;\n";
    close(F);

    print STDERR "Policy Saved in $FML_POLICY\n";
}


sub FlushLog
{
    local($config_dir);

    if ($TempolaryLogfile eq $MAKEFML_LOGFILE) {
	print STDERR "--- makefml log ($MAKEFML_LOGFILE) ---\n";
	&Cat($MAKEFML_LOGFILE);
	unlink $MAKEFML_LOGFILE if $TheFirstTime;
    }

    $config_dir = DestDir($CONFIG_DIR);
    # touch
    if (-d $config_dir && !-f "$config_dir/log") { 
	&Touch("$config_dir/log");
    }

    if (-w "$config_dir/log" && -f "etc/release_version") {
	$LOGFILE = "$config_dir/log";
	if (open(V, "etc/release_version")) {
	    chop($version = <V>);
	    &Log("installing fml $version is done");
	    close(V);
	}
	else {
	    &Debug("cannot open etc/release_version");
	}
    }
}


sub Cat
{
    local($in) = @_;

    open(CAT_OUT, $in) || return;
    select(STDOUT); $| = 1;
    while (<CAT_OUT>) { print $_;}
    close(CAT_OUT); 
}


sub Copy
{
    local($in, $out) = @_;
    local($mode) = (stat($in))[2];

    open(COPY_IN,  $in) || (&Log("ERROR: Copy < $in [$!]"), return 0);
    open(COPY_OUT, "> $out") || (&Log("ERROR: Copy > $out [$!]"), return 0);
    select(COPY_OUT); $| = 1; select(STDOUT); 
    chmod $mode, $out;

    while (sysread(COPY_IN, $_, 4096)) { print COPY_OUT $_;}
    close(COPY_OUT);
    close(COPY_IN);
    1;
}


sub AppendString2File
{
    local($s, $file) = @_;

    open(APP, ">> $file") || return 0;
    select(APP); $| = 1; select(STDOUT);
    print APP "$s\n" if $s;
    close(APP);
}


sub GetFile
{
    local($f) = @_;
    local($s, $dir, $d);

    for $dir (@INC) {
	$d = DestDir($dir);
	if (-f "$d/$f") { $f = "$d/$f"; last;}
	if (-f "$dir/$f") { $f = "$dir/$f"; last;}
    }

    if (open($f, $f)) {
	while (<$f>) { $s .= $_;}
	close($f);
	$s;
    }
    else {
	&Debug("cannot open $f");
	$NULL;
    }
}


sub Warn 
{
    local($s) = @_;
    local(@caller) = caller;
    print STDERR "Warning:(called from @caller)\n@_\n";
    $WarnBuf = "Warning:(called from @caller)\n@_\n";
    $WStatus .= "ExitStatus: WARN: $s\n";
}


sub XSWarn
{
    local($s) = @_;
    $WStatus .= "ExitStatus: WARN: $s\n";
}


sub Error
{
    local($buf) = @_;
    print STDERR "*** ERROR: $buf\n\n";
    $XStatus .= "ERROR: $buf\n";
}

sub _Error
{
    local($buf) = @_;
    $XStatus .= "ERROR: $buf\n";
}

sub Debug { print STDERR "@_\n";}


sub Log 
{ 
    local($str, $s) = @_;
    local($from) = $USER;
    local(@c) = caller;
    local($logfile);

    &GetTime(time);

    $logfile = DestDir($LOGFILE);
    # existence and append(open system call check)
    if (-f $logfile && open(APP, ">> $logfile")) {
	&Append2("$Now $str ($from)", $logfile);
	&Append2("$Now    $filename:$line% $s", $logfile) if $s;
    }
    elsif (-f $MAKEFML_LOGFILE && open(APP, ">> $MAKEFML_LOGFILE")) {
	&Append2("$Now $str ($from)", $MAKEFML_LOGFILE);
	&Append2("$Now    $filename:$line% $s", $MAKEFML_LOGFILE) if $s;
    }
    else {
	print STDERR "$Now $str ($from)\n\t$s\n";
    }
}


# append $s >> $file
# if called from &Log and fails, must be occur an infinite loop. set $nor
# return NONE
sub Append2 { &Write2(@_, 1);}
sub Write2
{
    local($s, $f, $o_append) = @_;

    if ($o_append && $s && open(APP, ">> $f")) { 
	select(APP); $| = 1; select(STDOUT);
	print APP "$s\n";
	close(APP);
    }
    elsif ($s && open(APP, "> $f")) { 
	select(APP); $| = 1; select(STDOUT);
	print APP "$s\n";
	close(APP);
    }
    else {
	local(@caller) = caller;
	print STDERR "Append2(@_) ERROR [@caller] \n";
    }

    1;
}


sub Touch  
{ 
    local($umask);

    $umask = umask;
    if ($GroupWritable eq 'fmlserv') {
	umask(007);
    }
    else {
	umask(077);
    }

    open(APP, ">>$_[0]"); 
    close(APP); 
    chown $<, $GID, $_[0] if $GID;

    sleep 1;
    $now = time;
    utime $now, $now, @_;

    umask($umask);
}


sub SignalLog 
{ 
    local($sig) = @_; 

    # clean up lockfiles
    if ($CleanUpLockFiles) {
	&v7'CleanUpLockFiles; #';
    }

    print STDERR "Caught Signal[$sig], shutting down ... \n\n";

    # &MakeFmlUnLock; infinite loop?     sleep(1);
    &FlushLog;

    exit(1);
}


sub Die
{
    local($s) = @_;
    print $s, "\n";
    &Exit1;
}


sub Exit1
{ 
    # clean up lockfiles
    if ($CleanUpLockFiles) {
	&v7'CleanUpLockFiles; #';
    }

    # &MakeFmlUnLock; infinite loop?     sleep(1);
    &FlushLog;

    exit(1);
}


# dummary
sub WholeMail { print STDERR "Dummy WholeMail [@_]\n";}
sub SetEvent  { print STDERR "Dummy SetEvent [@_]\n";}


sub SRand
{
    local($i) = time;
    $i = (($i & 0xff) << 8) | (($i >> 8) & 0xff) | 1;
    srand($i + $$); 
}


sub CompareCRC
{
    my ($src, $dst) = @_;
    &TraditionalATTUnixCheckSum($src) <=> &TraditionalATTUnixCheckSum($dst);
}

sub CompareWithCRCCache
{
    my ($f) = @_;
    my ($crc, $total, $cache);

    ($crc, $total) = &TraditionalATTUnixCheckSum($f);
    $cache = &Grep('^config.ph', $CHECK_SUM);
    $cache = (split(/\s+/, $cache))[1];
    print STDERR "CompareWithCRCCache: $crc $cache\n" if $debug;

    ($crc == $cache) ? 1 : 0;
}

# Reference: NetBSD:/usr/src/usr.bin/cksum/sum2.c
#  *** cksum utility is expected to conform to IEEE Std 1003.2-1992 ***
sub TraditionalATTUnixCheckSum
{
    my ($f) = @_;
    my ($crc, $total, $nr);

    $crc = $total = 0;
    if (open($f, $f)) {
	while (($nr = sysread($f, $buf, 1024)) > 0) {
	    my ($i) = 0;
	    $total += $nr;

	    for ($i = 0; $i < $nr; $i++) {
		$r = substr($buf, $i, 1);
		$crc += ord($r);
	    }
	}
	close($f);
	$crc = ($crc & 0xffff) + ($crc >> 16);
	$crc = ($crc & 0xffff) + ($crc >> 16);
    }
    else {
	print STDERR "ERROR: no such file $f\n";
    }

    ($crc, $total);
}


##### Section: IO misc
sub ResetAlignedBuffer
{
    $OutBufferLine = 0;
    undef $OutBuffer;
    undef @OutBuffer;
    undef %OutBuffer;
}

sub GobbleAlignedBuffer
{
    my ($s) = @_;

    my($x) = $OutBuffer[$OutBufferLine];

    # next line
    if (length($x) + length($s) > 75) { 
	$OutBufferLine++;
	$OutBuffer[$OutBufferLine] = "        ";
    }
    elsif (! $x) {
	$OutBuffer[$OutBufferLine] = "        ";
    }

    $OutBuffer[$OutBufferLine] .= " ". $s;
}

sub PrintAlignedBuffer
{
    for (@OutBuffer) { print $_, "\n";}
}


########## Message Language Extension
sub LangExtConv
{
    local($key) = @_; # /a/b/c style menu layer
    local($x, $msgfile);

    $msgfile = "$EXEC_DIR/messages/$LANGUAGE/menu_conf";
    while ($key =~ s@//@/@g) { 1;}
    $key =~ s@/@.@g;
    $key = 'menu_conf' .$key;

    if ($LANGUAGE eq 'Japanese') {
	# XXX %LangExtCache has no such key!
	# XXX so if %LangExtCache != NULL, return the value of the key
	if (%LangExtCache) {
	    return $LangExtCache{$key};
	}
	print STDERR "mis hit $key\n" if $debug_cgi;
	
	require 'libmesgle.pl';

        &MesgLE::CacheOn(*LangExtCache, $msgfile, 'euc');
	return $LangExtCache{$key};
    }
    elsif ($LANGUAGE eq 'English' || $LANGUAGE eq '') {
	return;	# return with undef value
    }
    else {
        $key;
    }
}


##############################################################################
##########
########## LOCK LIBRARY
##########

sub FlockP
{
    local($ml, $mldir) = @_;
    local($eval);

    # default
    undef $eval; # ensure (though useless)
    $eval .= "\$USE_FLOCK = 1;\n";

    # default=flock if first time or no config.ph;
    return 1 unless -f "$mldir/$ml/config.ph";

    # XXX 3.0B-TODO
    &GetConfigPH($ml);

    $ml'SPOOL_DIR{$ml} = &Value('SPOOL_DIR');
    $ml'FLockP{$ml}    = &Value('USE_FLOCK'); # return value
}

sub Lock
{
    local($ml, $mldir) = @_;

    return if $NotRequireLock;

    if (! -d "$mldir/$ml" && ! -d $mldir) {
	&Die("\n\n*** ERROR: $mldir nor $mldir/$ml not exists. stop. *** \n\n");
    }

    if (&FlockP($ml, $mldir)) {
	print STDERR "\n---Flock($ml, $mldir)\n" if $debug_lock;
	&FLock($ml, $mldir);
    }
    else {
	print STDERR "\n---V7 lock($ml, $mldir)\n" if $debug_lock;
	&V7Lock($ml, $mldir);
    }
}

sub UnLock
{
    local($ml) = @_;
    local($flockp) = $ml'FLockP{$ml};#'

    if ($debug) {
	my (@c) = caller;
	&Log("UnLock: $c[1] $c[2]");
    }

    return if $NotRequireLock;

    if ($flockp) {
	print STDERR "\n---Flock\n" if $debug_lock;
	&FUnLock($ml);
    }
    else {
	print STDERR "\n---V7 lock\n" if $debug_lock;
	&V7UnLock($ml);
    }
}

sub MakeFmlLock
{
    local($ml, $mldir) = @_;
    local($count, $dir);

    return if $NotRequireLock;

    # Lock Algorithm depends on each ML's config.ph,
    # so very complicated (which requires fmlserv's tricks)
    # lock struct
    #    ( flock_p  => lock_file (directory or lockfile) );

    ### Lock Type Probe 
    # only one
    if ($ml) {
	print "---Locking $ml ML" if $debug0; $count++;
	
	&Lock($ml, $mldir);
	$LockList{$ml} = $mldir;
    }
    else {
	print "---Locking $mldir\n\t";

	opendir(DIRD, $mldir);
	for $dir (readdir(DIRD)) {
	    next if $dir =~ /^\./;
	    next if $dir =~ /^\@/;
	    next unless -f "$mldir/$dir/config.ph";

	    next if $dir eq 'etc';

	    $count++;
	    print "$dir ";
	    &Lock($dir, $mldir);
	    $LockList{$dir} = "$mldir/$dir";
	}
	closedir(DIRD);
	print "\n";
    }

    if ($count) {
	print "\n   Locked. Go ahead!\n\n" if $debug0;
    }
    else {
	print "\n   Nothing exists. Go ahead anyway!\n\n";
    }
}


sub MakeFmlUnLock
{
    local($ml, $mldir) = @_;

    return if $NotRequireLock;

    if ($ml && $LockList{$ml}) {
	print "---UnLocking $ml ML" if $debug0;
	&UnLock($ml);
    }
    else {
	print "---UnLocking\n\t";

	opendir(DIRD, $mldir);
	for (readdir(DIRD)) {
	    next if /^\./;
	    next if /^\@/;
	    next unless -f "$mldir/$_/config.ph";
	    next unless $LockList{$_}; # skip if not locked;

	    print " $_";
	    &UnLock($_);
	}
	closedir(DIRD);
    }

    if ($debug0) {
	print "\nDone.\n" unless $Env eq 'HTTPD';
    }
    else {
	print "\n";
    }
}


########################################################################


sub InitTTY
{
    if (-e "/dev/tty") { $console = "/dev/tty";}

    open(IN, "<$console") || open(IN,  "<&STDIN"); # so we don't dingle stdin
    open(OUT,">$console") || open(OUT, ">&STDOUT");# so we don't dongle stdout
    select(OUT); $| = 1; #select(STDOUT); $| = 1;
}


sub ExecCmd
{
    local($_) = @_;
    local(@argv, $fp, $ml);

    # extension: permit ML{::,->}command syntax
    s/^(\S+)::(\S+)/$2 $1/;	# ML::command
    s/^(\S+)\->(\S+)/$2 $1/;	# ML->command

    @argv = split(/\s+/, $_);

    # XXX 3.0B-TODO: defined to remove dummy "sub DEFINE_*" ...;
    require 'libloadconfig.pl';
    &LoadDummyMacros;

    &GetCurConfig;
    &ResetVariables;

    if ($TheFirstTime) {
	;
    }
    else {
	if (!-d $EXEC_DIR) {
	    print STDERR "ExecDir($EXEC_DIR) NOT FOUND, STOP\n";
	    return;
	}
	if (!-d $ML_DIR) {
	    print STDERR "ML_DIR($ML_DIR) NOT FOUND, STOP\n";
	    return;
	}
    }

    # function pointer;
    $fp = shift @argv;
    $fp = $FP{$fp} ? $FP{$fp} : $fp; # this line is not used ?
    $fp = $MakeFmlProcAlias{$fp} || $fp; # aliases

    # special treat of "." extension
    if ($fp =~ /(\S+)\.(pgp.*|gpg)$/) {
	$fp = $1; $EncryptionMethodHint = $2;
    }

    $fp = $MakeFmlProcAlias{$fp} || $fp; # aliases
    if ($EncryptionMethodHint) {
	print STDERR "\$fp = $fp; \$EncryptionMethodHint = $2;\n";
    }

    # valid command?
    if (! $MakeFmlProc{$fp}) {
	&Debug("\n*** ERROR: command [$fp] NOT DEFINED ***");
	&Debug("   run \"makefml help\"");
	&Debug("        or ");
	&Debug("   see the document 'INSTALL' for more details\n");
	return;
    }

    # check arguments
    {
	local($not_require_ml);
	$ml = $argv[0];
	for (@NOT_REQUIRE_ML_ARG) {
	    # print STDERR "check $fp eq $_\n";
	    $fp eq $_ && $not_require_ml++;
	}

	if (! $not_require_ml) {
	    if (-d "$ML_DIR/$ml" && -f "$ML_DIR/$ml/config.ph") {
		; # O.K.;
	    }
	    else {
		&Debug("\n*** SYNTAX ERROR ***");
		&Debug("    makefml $fp mailing-list\n");
		&Debug("arguments of mailing-list is required\n");
		return;
	    }
	}
    }

    # Here $ml and approviate dir/files must be already defined
    # if $ml is required.
    if ($ml) {
	$LOGFILE = "$ML_DIR/$ml/log";
	&Touch($LOGFILE) unless -f $LOGFILE;
    }

    # uid check
    {
	local($mode, $uid, $gid) = (stat("$ML_DIR/$ml/config.ph"))[2,4,5];

	# Case: root but ML's owner IS NOT ROOT
	if ($UNISTD && $< == 0 && $uid != $<) { 
	    &WarnYourAreRoot;
	}
	elsif ((! $UNISTD) && $ENV{'USERNAME'} eq 'Administrator') {
	    &WarnYourAreRoot;
	}
    }


    # Lock all when "install"
    if ($TheFirstTime || $NOT_LOCK{$fp}) {
	# XXX TODO for 4.0.3 
	# XXX I don't understand why this hack locates here ???
	# XXX reload $LANGUAGE to translate messages on Web CGI
	# XXX &GetConfigPH($ml) if (!$TheFirstTime);
    }
    else {
	&MakeFmlLock($fp eq 'install' ? "" : $argv[0], $ML_DIR);
    }

    if ($MakeFmlProc{$fp}) {
	$SavedFP = $fp;	# Function Pointer
	local($fp) = $MakeFmlProc{$fp};	# not overwrite $fp for later use;
	local($fn) = $fp; $fn =~ s/do_//;
	&Log("makefml::${fn} @argv ") if $fp ne "do_install";
	if ($Env eq 'HTTPD') { &InitErrorBuffer($fp);}

	my ($ml, @opts) = @argv;
	my ($show) = $ml;
	undef $show if $fn eq 'log'; 

	my($curproc) = join(" ", $SavedFP, @opts);
	$curproc =~ s/\s*$//;
	print "DO \"$curproc\" for $ml mailing list.\n" 
	    if $show && ($fp !~ /^do\_show/) 
		&& ($fp !~ /do\_.*htpasswd/)
		&& ($fp !~ /do\_.*html\_passwd/);

	&$fp(@argv);
	if ($Env eq 'HTTPD') { &FixErrorBuffer($fp);}

	print "done.\n" if $show;
    }
    else {
	print "   Command [$fp] NOT DEFINED\n";
	print "   Please see the document 'INSTALL'\n\n";
	return;
    }

    # Unlock;
    if ($TheFirstTime || $NOT_LOCK{$fp}) {
	;
    }
    else {
	&MakeFmlUnLock($fp eq 'install' ? "" : $argv[0], $ML_DIR);
    }
}


sub _GetS
{
    local($.);
    $_ = <IN>;
}


sub GetString
{
    local($s);

    $s = &_GetS;

    # ^D
    if ($s eq "")  { print STDERR "'^D' Trapped.\n"; exit 0;}
    chop $s;

    $s;
}

sub TweakPath
{
    local($cwd, @dir, @path, $sep, $delim, $p, @npath, $inpath);

    if ($UNISTD) {
	chop($cwd = `pwd`); # ATTENTION! ONLY ON UNIX
    }
    else {
	chop($cwd = `cd`);
    }
    $sep = ($COMPAT_ARCH eq "WINDOWS_NT4")? ';': ':';
    $delim = ($COMPAT_ARCH eq "WINDOWS_NT4")? '\\': '/';
    @dir = split(/$delim/, $cwd);
    pop(@dir);
    $cwd = join($delim, @dir);
    @path = split(/$sep/, $ENV{'PATH'});

    $inpath = 1;
    foreach $p (@path) {
	if ($inpath) {
	    if (index($p, $cwd) == 0) {
		next;
	    } else {
		$inpath = 0;
	    }
	}
	push(@npath, $p);
    }
    $ENV{'PATH'} = join($sep, @npath);
}

sub FixPath
{
    local($prog) = @_;
    local($perl);
    local($mode) = (stat($prog))[2]; # preserve mode! 

    if ($perl = $ENV{'_PATH_PERL'}) {
	print STDERR "\n   replace perl with $perl\n" if $FixPathCount++ < 1;
    }
    elsif ($COMPAT_ARCH eq "WINDOWS_NT4") { 
	$perl = &__SearchPath('perl.exe');
    }
    else {
	$perl = &__SearchPath('perl');
    }

    local($newprog) = $prog.".new$$";

    open(PROG, $prog) || (&Warn("cannot open $prog"), return);
    open(NEW, "> $newprog") || (&Warn("cannot open $newprog"), return);
    select(NEW); $| = 1; select(STDOUT);

    while (<PROG>) {
	if ($. == 1) {
	    if (/^\#\!\s*\/usr\/local\/bin\/perl/ && $perl) {
		print NEW "\#\!$perl\n";
	    }
	    else {
		print NEW $_;
	    }
	    next;
	}

	next if /^\#\#\# AUTOMATICALLY REPLACED/;

	# recreate my own;
	if ($prog =~ /makefml|\.cgi$/ && 
	    /__MAKEFML_AUTO_REPLACED_HERE__/ && /^\$CONFIG_DIR/) {
	    #print STDERR "----Replace makefml::\$CONFIG_DIR -> $CONFIG_DIR\n";
	    print NEW "### AUTOMATICALLY REPLACED by makefml ($MailDate)\n";
	    print NEW "\$CONFIG_DIR = '$CONFIG_DIR'; ";
	    print NEW "\# __MAKEFML_AUTO_REPLACED_HERE__\n";
	    next;
	}

	print NEW $_;
    }
    close(NEW);
    close(PROG);
    # sleep 1;

    chmod $mode, $newprog;

    if ($COMPAT_ARCH eq "WINDOWS_NT4") { 
	rename($prog, "${prog}.bak") || &Warn("cannot rename $prog $prog.bak");
	rename($newprog, $prog) || &Warn("cannot rename $newprog $prog");
    }
    else {
	rename($prog, "${prog}.bak") || &Warn("cannot rename $prog $prog.bak");
	rename($newprog, $prog) || &Warn("cannot rename $newprog $prog");
    }
}


sub __SearchPath
{
    local($f) = @_;
    local($p, @path);

    if ($f eq 'perl') {
	if ($ENV{'_PATH_PERL'}) { return $ENV{'_PATH_PERL'};}
    }

    # cache on
    if ($PathCache{$f}) { return $PathCache{$f};}

    if ($COMPAT_ARCH eq "WINDOWS_NT4") { 
	@path = split(/;/, $ENV{'PATH'});
    }
    else {
	@path = split(/:/, $ENV{'PATH'});
    }

    # too pesimistic?
    for ("/usr/pkg/bin", 
	 "/usr/share/bin", 
	 "/usr/contrib/bin", 
	 "/usr/gnu/bin", 
	 "/usr/bin", 
	 "/bin", 
	 "/usr/ucb",
	 "/usr/ucblib",  # NEC EWS4800 
	 # NT Extention
	 "/perl5/bin", 
	 "c:\\perl\\bin", 
	 "d:\\perl\\bin", 
	 "e:\\perl\\bin",

	 # search for "htpasswd"
	 "/usr/local/apache/bin",
	 "/usr/contrib/apache/bin",
	 ) {
	push(@path, $_);
    }

    for (@path) { 
	$p = $_ ; $p =~ s#\\#/#g;
	if (-f "$p/$f") { 
	    $PathCache{$f} = "$_/$f";
	    return "$_/$f";
	}
    }

    print STDERR "$f is not found\n";
    $f; # try anyway 
}


############ CFVersion 2 -> 3

### convert CF2 -> CF3
sub ConvertCF2to3
{
    local(*config, *MAKE_FML) = @_;

    print STDERR "--ConvertCF2to3\n" if $verbose || $debug;

    ### Section: config
    @config = ("CFVersion",
	       "DOMAINNAME",
	       "FQDN",
	       "debug",
	       "MAINTAINER",
	       "MAIL_LIST",
	       "PERMIT_POST_FROM",
	       "REJECT_POST_HANDLER",
	       "CONTROL_ADDRESS",
	       "PERMIT_COMMAND_FROM",
	       "REJECT_COMMAND_HANDLER",
	       "AUTO_REGISTRATION_TYPE",
	       "AUTO_HTML_GEN",
	       "ML_FN",
	       "XMLNAME",
	       "XMLCOUNT",
	       "BRACKET",
	       "SUBJECT_TAG_TYPE");

    ### Section: Remove obsolete variable
    undef $config{"ML_MEMBER_CHECK"};

    ### Section: Acces Policy and Auto Registration

    # default 
    $config{"PERMIT_POST_FROM"}       = "members_only";
    $config{"PERMIT_COMMAND_FROM"}    = "members_only";
    $config{"REJECT_POST_HANDLER"}    = "reject";
    $config{"REJECT_COMMAND_HANDLER"} = "reject";
    $config{"AUTO_REGISTRATION_TYPE"} = "confirmation";

    if ($MAKE_FML{'AUTO_REGIST_WITH_CONFIRM'}) {
	undef $MAKE_FML{'AUTO_REGIST_WITH_CONFIRM'};

	$config{"REJECT_POST_HANDLER"}    = "auto_regist";
	$config{"REJECT_COMMAND_HANDLER"} = "auto_regist";
	$config{"AUTO_REGISTRATION_TYPE"} = "confirmation";
    }

    if ($MAKE_FML{"DELIVERY_MODE"} eq "distribute") {
	$config{"PERMIT_POST_FROM"} = "anyone";
    }
    elsif ($MAKE_FML{"DELIVERY_MODE"} eq "distribute_with_member_check") {
	$config{"PERMIT_POST_FROM"} = "members_only";
    }
    undef $MAKE_FML{"DELIVERY_MODE"};

    if ($MAKE_FML{"SUBJECT_TAG"}) {
	$config{"SUBJECT_TAG"} = $MAKE_FML{"SUBJECT_TAG"};
	undef $MAKE_FML{"SUBJECT_TAG"};
    }

    ### Section: Options
    $config{'USE_MIME'} = $MAKE_FML{'OPT_MIME'};
    undef $MAKE_FML{'OPT_MIME'};

    ### Version 3 
    $config{'REMOTE_ADMINISTRATION_AUTH_TYPE'} = "crypt";
    $config{'PGP_PATH'} = "$ML_DIR/$ml/etc/pgp";

    ### convertion ends; so we declare now 3!;
    $config{"CFVersion"} = "3";
}


sub ConvertCF3to3_1
{
    local(*config, *MAKE_FML) = @_;

    ### Section: Header
    # 3.1 (1997/10/14) is after 2.1A#8 
    $config{'REWRITE_TO'} = 1 if $config{'CFVersion'} < 3.1; 
    # 2.1 release default;
    $config{'REWRITE_TO'} = 0 if $config{'NOT_REWRITE_TO'}; 

    ### convertion ends; so we declare now 3.1!;
    $config{"CFVersion"} = "3.1";

    # 3.1 -> 3.2
    $config{'PASS_ALL_FIELDS_IN_HEADER'} = $config{'SUPERFLUOUS_HEADERS'};
    $config{"CFVersion"} = "3.2";
}


# USE_MIME is an exception of treatment
# USE_MIME 1 and $MAKE_FML{OPT_MIME} = 1
# since we show the menu determined by %MAKE_FML values;
sub OutPutLocalConfig
{
    local(*MAKE_FML) = @_;
    local($output_count);

    ### %MAKE_FML
    while (($k, $v) = each %MAKE_FML) {
	next unless $v;
	print STDERR "MAKE_FML\t$k\t=>$v\n" if $debug;
    }

    print STDERR "--- OUTPUT CF LOCAL CONFIG\n" if $debug0;

    ### output of other configurations
    print CF "\n\n\n" unless $UnderConfigTemplate;
    print CF "\n";
    print CF "LOCAL_CONFIG\n\n";
    print CF "\#__MAKEFML_LOCAL_CONFIG__\n";
    print CF "\# configured by $0 on $MailDate\n";
    print CF "\# *** DO NOT EDIT MANUALLY THIS BLOCK!!! ***\n";


    ### POINT!!!
    ### $local_config .= $_ if /\$MAKE_FML/;
    while (($k, $v) = each %MAKE_FML) {
	printf STDERR "   \$MAKE_FML %-20s -> %s\n", $k, $v if $debug;
	next unless $v;
	undef $MAKE_FML{$k}; # ATTENTION! RESET HERE;
    }

    # abnormal
    for (keys %MAKE_FML) {
	$value = $MAKE_FML{$_};
	next unless $value;
	$value = ($value =~ /^\d+$/) ? $value : "\"$value\"";

	print CF "\$MAKE_FML{'$_'} = $value;\n";
	$output_count++;
    }

    # CFVersion 2
    if ($output_count && !$config{"CFVersion"}) {
	print CF "require 'libmakefml.pl';\n";
	print CF "&ConfigByMakeFml;\n";
    }

    # output to $DIR/cf
    print CF "\#__END_OF_MAKEFML_LOCAL_CONFIG__\n";
    print CF "\n\n\# YOU CAN EDIT MANUALLY AFTER HERE.\n\n";

    # OUTPUT: USER-DEFINED $DIR/cf local config 
    print CF $USER_DEFINED_LOCAL_CONFIG;
    print CF "\n";

    printf STDERR "\n---END OF MAKE_FML OUTPUT\n\n", $k, $v if $debug;
}


sub Query
{
    local($menu, $query, $pat, $default, $batch) = @_;
    
    print "Query(debug): ($menu, $query, $pat, $default)\n" if $debug;
    print "\n" unless $MenuNarrowLineSkip;

    while (1) {
	#print "menu={$menu} query={$query}\n";
	print "${CurTag}${menu} ($query) [$default] ";
	if ($batch) {
	    $cmd = $default;
	} else {
	    $cmd = &GetString;
	}
	print "\n";

	if ($cmd =~ /^($pat)$/) { last;}
	if ($cmd =~ /^\s*$/) { $cmd = $default; last;}

	print "$CurTag   *** WARNING! Please input one of ($query) ***\n\n";
    }    

    $cmd;
}


sub ResetVariables
{
    # anyway set;
    &GetCurConfig;

    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	$USER = $USER || $ENV{'USERNAME'};
    }
    else {
	$USER = $USER || (getpwuid($<))[0];
    }

    $EXEC_DIR = $CurConfig{'EXEC_DIR'};
    $ML_DIR   = $CurConfig{'ML_DIR'};
    $DOMAIN   = $CurConfig{'DOMAIN'};
    $FQDN     = $CurConfig{'FQDN'};
    $GID      = &GetGID($CurConfig{'GROUP'}) if $CurConfig{'GROUP'};
    $TZ       = $CurConfig{'TZ'} || '+0900'; # COMPAT UNTIL FML 2.2;
    $VENDOR   = $CurConfig{'VENDOR'};
    $CGI_PATH = $CurConfig{'CGI_PATH'} || $ENV{'CGI_PATH'} || '/cgi-bin/fml';

    # CGI mail server configurations
    $MTA                 = $CurConfig{'MTA'} || 'sendmail';
    $HOW_TO_UPDATE_ALIAS = $CurConfig{'HOW_TO_UPDATE_ALIAS'} || 'newaliases';

    # overwritten for each ml
    $LANGUAGE = &Value('LANGUAGE') || $CurConfig{'LANGUAGE'};

    # set up /cgi-bin/ directory directive for www server
    # this directory should be special
    # import environment REAL_CGI_PATH
    if ($EXEC_DIR) {
	$REAL_CGI_PATH = $CurConfig{'REAL_CGI_PATH'} || 
	    $REAL_CGI_PATH || $ENV{'REAL_CGI_PATH'};

	if (! $REAL_CGI_PATH) {
	    $REAL_CGI_PATH = $CGI_PATH;
	    $REAL_CGI_PATH =~ s#^/+##;
	    $REAL_CGI_PATH = $EXEC_DIR. '/www/share/'.$REAL_CGI_PATH;
	}

	# www directory
	$CGI_AUTHDB_DIR = $CurConfig{'CGI_AUTHDB_DIR'} ||
	    $CGI_AUTHDB_DIR|| "$EXEC_DIR/www/authdb";
    }
    
    if ($CurConfig{'GROUP'} && !$GID) { 
	print "Group of ML operatos is not defined in /etc/group\n";
	print "Please define it in first!\n";
	exit 0;
    }

    if ($CurConfig{'PERSONAL_OR_GROUP'} =~ /^(group|fmlserv)$/) {
	$GroupWritable = $CurConfig{'PERSONAL_OR_GROUP'};
    }
    else {
	$GroupWritable = 0;	
    }

    $ML_ETC_DIR = "$ML_DIR/etc";

    # Mailing list name is all lower case;
    # $ml =~ tr/A-Z/a-z/;
    if ((! $NOT_CHECK_ML_EXIST) && $ml && (! -d "$ML_DIR/$ml")) {
	&Die("Cannot find $ml. you've not created it yet?\n");
    }

    # sys/$COMPAT_ARCH
    # load some compatible configuratinos
    if ($CPU_TYPE_MANUFACTURER_OS =~ /solaris2|sysv4/i) {
	$COMPAT_ARCH = 'SOLARIS2';
	print STDERR "\neval require $EXEC_DIR/sys/$COMPAT_ARCH/depend.pl\n"
	    if $debug;
	if (-f "$EXEC_DIR/sys/$COMPAT_ARCH/depend.pl") {
	    local($VARRUN_DIR) = &Value(VARRUN_DIR) || 'var/run';
	    eval require "$EXEC_DIR/sys/$COMPAT_ARCH/depend.pl";
	    print STDERR ">", $FlockFile, "\n" if $debug;
	    &Error($@) if $@;
	}
    }

    # check sum cache for cf and config.ph diagnostic check
    $CHECK_SUM = "$ML_DIR/$ml/.crc";
}


sub GenCrontab
{
    local($uid);

    print STDERR "\n   Update $ML_ETC_DIR/crontab/$USER\n";

    &Conv('etc', 
	  "$EXEC_DIR/etc/makefml/msend_master", 
	  "$ML_ETC_DIR/crontab/$USER.master");

    open(TAB, "> $ML_ETC_DIR/crontab/$USER") || 
	(&Warn("cannot open $ML_ETC_DIR/crontab/$USER"), return);
    select(TAB); $| = 1; select(STDOUT);

    opendir(DIRD, $ML_DIR) || (&Warn("cannot open $ML_DIR"), return);
    for (readdir(DIRD)) {
	next if /^\./;
	next if /^\@/;

	$uid = (stat("$ML_DIR/$_/crontab"))[4];

	# if $uid == real-UID;
	if (($uid == $<) && -f "$ML_DIR/$_/crontab") {
	    if (open(CRONTAB, "$ML_DIR/$_/crontab") ) {
		while (<CRONTAB>) { print TAB $_;}
		close(CRONTAB);
	    }
	}

    }
    closedir(DIRD);

    close(TAB);
}


sub CollectAliases
{
    local($ml, $alias, $alias_new);

    my ($cur_umask) = umask;
    &SetPublicUmask;

    $alias     = "$ML_ETC_DIR/aliases";
    $alias_new = "$ML_ETC_DIR/aliases.new.$$";

    print STDERR "\n   Update $alias\n";

    open(ALIAS, "> $alias_new") || 
	(&Warn("cannot open $alias_new"), return);
    select(ALIAS); $| = 1; select(STDOUT);

    opendir(DIRD, $ML_DIR) || (&Warn("cannot open $ML_DIR"), return);
    for $ml (readdir(DIRD)) {
	next if $ml =~ /^\./;
	next if $ml =~ /^\@/;
	next if $ml =~ /^etc/;

	if (-f "$ML_DIR/$ml/aliases") {
	    print STDERR "import $ML_DIR/$ml/aliases\n" if $debug;
	    if (open(COLALIAS, "$ML_DIR/$ml/aliases") ) {
		while (<COLALIAS>) { print ALIAS $_;}
		close(COLALIAS);
	    }
	}

    }
    closedir(DIRD);
    close(ALIAS);

    if (! rename($alias_new, $alias)) {
	&Error("cannot rename $alias_new, $alias");
    }

    umask($cur_umask);
}


sub RemoveMember
{
    local($file, $addr) = @_;
    &CtlAddrList("bye", $file, $addr);
}


sub is_valid_user_syntax
{
    my ($addr) = @_;
    my ($addr_pattern, $user_pattern) = ();

    eval q{
	use FML::Restriction::Base;
	my $obj = new FML::Restriction::Base;
	my $exp = $obj->basic_variable();
	$user_pattern = $exp->{  'user' };
	$addr_pattern = $exp->{ 'address' };
    };
    if ($@) {
	print STDERR "Warning: cannot load FML::Restriction::Base ($@, @INC)\n";

	# see FML::Restriction::Base;
	my $domain_regexp  = '[-A-Za-z0-9\.]+';
	my $user_regexp    = '[-A-Za-z0-9\._]+';
	$user_pattern = $user_regexp;
	$addr_pattern = "$user_regexp\@$domain_regexp";
    }

    if ($addr =~ /^($addr_pattern)$/ || $addr =~ /^($user_pattern)$/) {
	return 1;
    }
    else {
	return 0;
    }
}


sub _exact_match
{
    my ($buf, $addr) = @_;

    if ($buf =~ /^\#\s*($addr.*)/i || $buf =~ /^($addr.*)/i) {
	my ($a) = split(/\s+/, $1);
	return AddressMatch($a, $addr);
    }

    return 0;
}


sub CtlAddrList
{
    local($proc, $file, $addr, $opt) = @_;
    local($mode) = (stat($file))[2];
    local($found, $buf, $line, $sumbuf, $filenew);
    my $orig_addr = $addr;

    # check the input
    unless (is_valid_user_syntax($addr)) {
	&Error("invalid address");
	return 0;
    }

    # XXX tricky hack
    $addr =~ s/\./\\\./g;
    $addr =~ s/\?/\\\?/g;
    $addr =~ s/\+/\\\+/g;
    $addr =~ s/\//\\\//g;

    $filenew = $file.".new.$$";

    open(F, $file)          || (&Warn("cannot open $file"), return 0);
    open(NEW, "> $filenew") || (&Warn("cannot open $filenew"), return 0);
    select(NEW); $| = 1; select(STDOUT);

    while (<F>) {
	chop;

	if ((/^\#\s*$addr/i || /^$addr/i) &&
	    _exact_match( $_, $orig_addr)) {
	    $line = $_;
	    $buf .= "\t- $_\n";

	    if ($proc eq 'bye') {
		s/^\#\s*($addr)/\#\#BYE $1/i;
		s/^($addr)/\#\#BYE $1/i;
	    }
	    elsif ($proc eq 'on') {
		s/^\#\s*($addr)/$1/;
	    }
	    elsif ($proc eq 'off' || $proc eq 'skip') {
		s/^($addr)/\# $1/i;
	    }
	    elsif ($proc eq 'chaddr') {
		s/^(\#\s*)$addr/$1 $opt/i;
		s/^$addr/$opt/i;
	    }
	    elsif ($proc eq 'matome' || $proc eq 'digest') {
		$opt =~ s/\s*//g;
		$opt =~ s/^m=//;
		s/\s+m=\S+//g;
		s/^(\#\s*$addr)/$1 m=$opt/i;
		s/^($addr)/$1 m=$opt/i;
		s/m=0\s*//;
	    }

	    $buf .= "\t+ $_\n";

	    # difference buffer 
	    if ($line ne $_) { 
		$found++;
		$sumbuf .= $buf;
	    }
	}

	print NEW $_, "\n";
    }

    close(NEW);
    close(F);

    rename($file, "${file}.bak") || 
	(&Warn("cannot rename $file $file.bak"), return 0);
    rename($filenew, $file) ||
		(&Warn("cannot rename $filenew $file"), return 0);

    chmod $mode, $file;

    if ($sumbuf) {
	print "\n\t--- $file\n";
	print $sumbuf;
    }

    $found;
}


sub Mesg { print STDERR "$_[1]\n";}

sub Conv
{
    local($ml, $example, $out) = @_;
    local($uid, $gid, $format, $info, $ctladdr, $mail_list, $maintainer);
    local($crontime) = 0;
    local(@caller) = caller;

    {
	my ($s) = $out;
	$s =~ s@.*/@@;
	&GobbleAlignedBuffer($s);
    }

    # &ApplyPolicy;
    $format    = $Policy{'CONTROL_ADDRESS_FORMAT'};

    if ($debug) {
	print STDERR "\tCONTROL_ADDRESS_FORMAT\t$format\n";
    }

    # Case: under fml-source/drafts/
    if ($example =~ /\/drafts\//) {
	# English
	if ($LANGUAGE eq 'English' || $LANGUAGE eq 'Japanese') {
	    if ( $example =~ /^(.*drafts\/)([-\w]+)$/) {
		my ($dir, $fn) = ($1, $2);
		$example = "$dir/$LANGUAGE/$fn";
	    }
	}
	else {
	    &Log("unknown language [$Language]");
	    return 0;
	}
    }

    # open template
    if (-e $example) {
	open(EXAMPLE, $example) || 
	    (&Warn("cannot open $example"), return 0);
    }
    else {
	&Warn("cannot find template $example");
	return 0;
    }

    open(CF, "> $out") || (&Warn("cannot open $out from @caller"), return 0);
    select(CF); $| = 1; select(STDOUT);
    
    print STDERR "\t$out\n" if $debug0;

    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	$PERL_PATH = $^X;
	$USER = $USER || $ENV{'USERNAME'};
    }
    else {
	$PERL_PATH = $^X;
	$uid   = $uid || (getpwuid($<))[2];
	$gid   = $gid || (getpwuid($<))[3];
    }

    # crontab time
    &SRand;
    $crontime = int(rand(6)) || 0;

    # $STRUCT_SOCKADDR
    &SetSockAddr($CPU_TYPE_MANUFACTURER_OS);

    # XXX %config is passed as global variable but it may be a bug!
    # XXX e.g. see 'sub do_create_doc_template'
    # default
    $mail_list  = $config{'MAIL_LIST'}       || "$ml\@$DOMAIN";;
    $ctladdr    = $config{'CONTROL_ADDRESS'} || "$ml-ctl\@$DOMAIN";
    $maintainer = $config{'MAINTAINER'}      || "$ml-admin\@$DOMAIN";

    while (<EXAMPLE>) {
	# substitute following the policy default
	if ($format) {
	    # exception: CtlAddr == fmlserv || MAIL_LIST
	    if ($format =~ /^(fmlserv|_ML_)$/) {
		# aliases: remove the entry
		if ($example =~ /aliases$/ && /^_ML_-ctl:/) {
		    local($repl) = 
			"\# _ML_-ctl is not used. comment out\n\# _ML_-ctl";
		    s/^_ML_-ctl/$repl/;

		    # not used
		    $ctladdr = $NULL;
		}

		# cf file: null entry if CtlAddr == _ML_
		if ($example =~ /cf$/ && $format eq '_ML_') {
		    s/^(CONTROL_ADDRESS).*/$1/;
		    $ctladdr = $NULL;
		}
		elsif ($example =~ /cf$/ && $format eq 'fmlserv') {
		    s/_ML_-ctl/fmlserv/;
		    $ctladdr = "fmlserv\@$DOMAIN";
		}
	    }
	    # 
	    # CtlAddr != fmlserv NOR _ML_
	    else {
		s/_ML_-ctl/$format/g;

		# ctladdr
		$ctladdr = "_ML_-ctl\@$DOMAIN";
		$ctladdr =~ s/_ML_-ctl/$format/g;
		$ctladdr =~ s/_ML_/$ml/g;
	    }
	}

	# perl
	s/_PERL_PATH_/$PERL_PATH/g;

	# language
	s/_LANGUAGE_/$LANGUAGE/g;

	# TZ
	s/_TZ_/$TZ/g;

	# Command Trap keyword
	s/_CTK_/$CTK/g;

	# config
	s/_EXEC_DIR_/$EXEC_DIR/g;
	s/_ML_DIR_/$ML_DIR/g;
	s/_ML_/$ml/g;

	s/_MAIL_LIST_/$mail_list/g;
	s/_CTLADDR_/$ctladdr/g;
	s/_MAINTAINER_/$maintainer/g;

	s/_DOMAIN_/$DOMAIN/g;
	s/_FQDN_/$FQDN/g;
	s/_USER_/$USER/g;
	s/_OPTIONS_/$opts/g;
	s/_CPU_TYPE_MANUFACTURER_OS_/$CPU_TYPE_MANUFACTURER_OS/g;
	s/_STRUCT_SOCKADDR_/$STRUCT_SOCKADDR/g;
	s/XXUID/$uid/g;
	s/XXGID/$gid/g;

	##
	s/_CRON_TIME_/$crontime/g;

	# www/cgi interface
	s/_SSL_REQUIRE_SSL_/$SSL_REQUIRE_SSL/g;
	s/_CGI_AUTHDB_DIR_/$CGI_AUTHDB_DIR/g;

	if (/dev\.null.*\@domain\.uja/) {
	    s/domain\.uja/$DOMAIN/g;
	    s/dev\.null/$ml/g;
	}

	print CF $_;
    }

    close(EXAMPLE);
    close(CF);

    print STDERR $info if $info;
}


sub GetTime
{
    local($time) = @_;

    @WDay = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
    @Month = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 
	      'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
    
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
	localtime($time||time);
    $Now = sprintf("%02d/%02d/%02d %02d:%02d:%02d", 
		   ($year % 100), $mon + 1, $mday, $hour, $min, $sec);
    $MailDate = sprintf("%s, %d %s %d %02d:%02d:%02d %s", 
			$WDay[$wday], $mday, $Month[$mon], 
			1900 + $year, $hour, $min, $sec, 
			$isdst ? $TZONE_DST : $TZone);

    # /usr/src/sendmail/src/envelop.c
    #     (void) sprintf(tbuf, "%04d%02d%02d%02d%02d", tm->tm_year + 1900,
    #                     tm->tm_mon+1, tm->tm_mday, tm->tm_hour, tm->tm_min);
    # 
    $CurrentTime = sprintf("%04d%02d%02d%02d%02d", 
			   1900 + $year, $mon + 1, $mday, $hour, $min);

    $MailDate;
}


sub FixIncludeHeader
{
    local($file, $include, @include, $INCDIR);

    $include =q#sys/types.h unistd.h#;
    @include = split(/\s+/, $include);
    $INCDIR  = '/usr/include';

    &ResetVariables;

    &GobbleAlignedBuffer('fmlwrapper.h');

    if (open(GUESS, "> $ML_DIR/$ml/fmlwrapper.h")) {
	foreach $file (@include) {
	    if ( -f "$INCDIR/$file" ) {
		print GUESS "\#include <$file>\n";
	    }
	    else {
		; # print STDERR "$INCDIR/$file not found\n";
	    }
	}

	close(GUESS);
    }
}


#################################################################
sub do_help
{
    print "makefml:\n";
    print "   SYNOPSIS: makefml command\n";
    print "             makefml command <ML>  options\n";
    print "             makefml <ML>::command options\n";
    print "\n";
    print "   available commands\nt";
    print join("\n\t", (keys %MakeFmlProc));
    print "\n\n";
}


sub do_passwd
{
    local($ml, $member, $passwd) = @_;
    local($passwd_file);

    print "---Changing Passwd of Admin $member in $ml mailing list\n"
	if $debug0;

    &ResetVariables;
    $cf = "$ML_DIR/$ml/cf";
    # set %config, eval %MAKE_FML in it;
    # &GetCF($cf, $ml, *config, *cur_config);
    &GetConfigPH($ml); # store value in "config_ph" name space.

    # $ml/etc
    &MakeSubDir("$ML_DIR/$ml/etc");

    # here we go! 
    &SetWritableUmask;
    $passwd_file= &Value("PASSWD_FILE") || "$ML_DIR/$ml/etc/passwd";

    -f $passwd_file || &Touch($passwd_file);

    # perserve the current inode $mode
    my ($saved_permission) = (stat($passwd_file))[2];

    while (!$member || !$passwd) {
	if (! $member) {
	    print "Address: ";
	    chop($member = <STDIN>);
	}
	else {
	    print "Address: $member\n";
	}

	if (! $passwd) {
	    # no echo
	    &__system("stty", "-echo") if $UNISTD;

	    print "Password: ";
	    chop($passwd = <STDIN>);
	    print "\n";

	    print "Retype Password: ";
	    chop($new_passwd = <STDIN>);
	    print "\n";

	    if ($passwd ne $new_passwd) {
		undef $passwd;
		undef $new_passwd;
		next;
	    }

	    &__system("stty", "echo") if $UNISTD;
	}

	if (!$member || !$passwd) {
	    &Warn("ERROR: Please input NOT NULL Address and Password.");
	    &Log("makefml::passwd address is not defined")  if !$member;
	    &Log("makefml::passwd password is not defined") if !$passwd;
	}
    }

    require 'libcrypt.pl';
    $init = 1;	# if new-comer, initialize the passwd;

    $REMOTE_ADMINISTRATION_AUTH_TYPE = 
	&Value('REMOTE_ADMINISTRATION_AUTH_TYPE') || "crypt";

    if (&ChangePasswd($passwd_file, $member, $passwd, $init)) {
	print "   Passwd Changed ($passwd_file).\n";
	&Log("makefml::passwd changing $passwd_file succeed");
	print "status ok\n"; # XXX ???? this is for debug ??  (can I remove?)
	# $XStatus = 'OK:';
    }
    else {
	print "   Passwd Change Fails ($passwd_file).\n";
	&Log("makefml::passwd changing $passwd_file fails");
    }

    # reset inode $mode
    chmod $saved_permission, $passwd_file;
}


# hidden function only CGI calls
sub do_html_passwd
{
    local($ml, $member, $passwd) = @_;
    local($passwd_file, %config, %cur_config);

    print "---Changing Passwd of Admin $member in $ml mailing list\n"
	if $debug0;

    &Error("empty password") unless $passwd;

    &ResetVariables;
    $cf = "$ML_DIR/$ml/cf";
    # set %config, eval %MAKE_FML in it;
    &GetCF($cf, $ml, *config, *cur_config);

    # $ml/etc
    &MakeSubDir("$ML_DIR/$ml/etc");

    # here we go! 
    &SetWritableUmask;
    $passwd_file= $cur_config{"PASSWD_FILE"} || "$ML_DIR/$ml/etc/passwd";

    -f $passwd_file || &Touch($passwd_file);

    # perserve the current inode $mode
    my ($saved_permission) = (stat($passwd_file))[2];

    require 'libcrypt.pl';
    $init = 1;	# if new-comer, initialize the passwd;

    $REMOTE_ADMINISTRATION_AUTH_TYPE = 
	    $config{'REMOTE_ADMINISTRATION_AUTH_TYPE'} || "crypt";

    if (&ChangePasswd($passwd_file, $member, $passwd, $init)) {
	print "   Passwd Changed ($passwd_file).\n";
	&Log("makefml::passwd changing $passwd_file succeed");
    }
    else {
	print "   Passwd Change Fails ($passwd_file).\n";
	&Log("makefml::passwd changing $passwd_file fails");
    }

    # sync w/ $CGI_AUTHDB_DIR/*/htpasswd
    &do_html_htpasswd($ml, $member, $passwd);

    # reset inode $mode
    chmod $saved_permission, $passwd_file;
}


# hidden function only CGI calls
sub do_html_htpasswd
{
    local($ml, $member, $passwd) = @_;
    local($passwd_file, %config, %cur_config);

    &ResetVariables;
    $cf = "$ML_DIR/$ml/cf";
    # set %config, eval %MAKE_FML in it;
    &GetCF($cf, $ml, *config, *cur_config);

    # $ml/etc
    &MakeSubDir("$ML_DIR/$ml/etc");

    # here we go! 
    &SetWritableUmask;
    $passwd_file= $cur_config{"PASSWD_FILE"} || "$ML_DIR/$ml/etc/passwd";

    -f $passwd_file || &Touch($passwd_file);

    # make directory
    &SetPublicUmask;
    &MkDirHier("$CGI_AUTHDB_DIR/ml-admin");
    &MkDirHier("$CGI_AUTHDB_DIR/ml-admin/$ml");

    # here we go to convert etc/passwd to some/whare/m-admin/$ml/htpasswd
    local($f, $x, $fnew);
    $f    = "$CGI_AUTHDB_DIR/ml-admin/$ml/htpasswd";
    $fnew = "$CGI_AUTHDB_DIR/ml-admin/$ml/htpasswd.new.$$";

    # perserve the current inode $mode
    my ($saved_permission) = (stat($f))[2];

    print STDERR "\n   change htpasswd ($f)\n";

    if ($x = &Grep("^$member\\s+", $passwd_file)) {
	# convert format to htpasswd style
	# affect only first space	
	$x =~ s/\s+/:/; 

	if (&__html_htpasswd_repl($f, $fnew, $member, $x)) {
	    if (! rename($fnew, $f)) {
		&Error("cannot rename $fnew $f");
	    }
	}
    }
    else {
	&Error("cannot find $member in $passwd_file");
    }

    # reset inode $mode
    chmod $saved_permission, $f;
}


# hidden function only CGI calls
# change htpassword for  /cgi-bin/fml/admin/ layer.
sub do_html_cgiadmin_htpasswd
{
    local($ml, $member, $passwd, $action) = @_;
    local($f, $x, $fnew);

    &ResetVariables;
    &SetWritableUmask;

    # here we go to convert etc/passwd to some/whare/m-admin/$ml/htpasswd
    $f    = "$CGI_AUTHDB_DIR/admin/htpasswd";
    $fnew = "$CGI_AUTHDB_DIR/admin/htpasswd.new.$$";

    # perserve the current inode $mode
    my ($saved_permission) = (stat($f))[2];

    print STDERR "\n   change htpasswd ($f)\n\n";
    $x = $member .":". crypt($passwd, $member);

    # If $action == 'bye', remove $member.
    # If not, add or change $member.
    if (&__html_htpasswd_repl($f, $fnew, $member, $x, $action)) {
	if (-s $fnew) { 
	    if (rename($fnew, $f)) {
		if ($action eq 'bye') {
		    print "   removed $member\n";
		}
		else {
		    print "   added $member or changed $member password\n";
		}
	    }
	    else {
		&Error("cannot rename $fnew $f");
	    }
	}
	else {
	    &Error("something wrong! since file size 0. no operation.");
	}
    }

    # reset inode $mode
    chmod $saved_permission, $f;
}


sub __html_htpasswd_repl
{
    local($f, $fnew, $member, $x, $action) = @_;

    $x =~ s/\n$//;
    print STDERR "($f, $fnew, $member, $x)\n" if $debug;

    # perserve the current inode $mode
    my ($saved_permission) = (stat($f))[2];

    if (! open($fnew, "> $fnew")) {
	&Error("cannot open $fnew");
	return 0;
    }

    if (-f $f) {
	if (open($f, $f)) {
	    while (<$f>) {
		next if /^$member:/;
		print $fnew $_;
	    }
	    close($f);

	    print $fnew $x, "\n" unless $action eq 'bye';
	    close($fnew);
	}
	else {
	    &Error("cannot open $f");
	    return 0;
	}
    }
    # first time
    else {
	print $fnew $x, "\n";
    }

    close($fnew);

    # reset inode $mode
    chmod $saved_permission, $f;

    1;
}


sub do_htpasswd
{
    local($ml, $user) = @_;
    local($prog, $flag);
    local($dir, $pwf);

    if (! $user) {
	print STDERR "   ERROR!\n";
	print STDERR "   Usage: htpasswd $ml user\n\n";
	return;
    }

    &ResetVariables;
    $prog = &__SearchPath('htpasswd');

    if (! ($prog && -x $prog)) {
	&Error("cannot find 'htpasswd'");
	return;
    }

    $dir = "$CGI_AUTHDB_DIR/ml-admin/$ml";
    $pwf = "$CGI_AUTHDB_DIR/ml-admin/$ml/htpasswd";

    if (! -f $pwf) {
	$flag = '-c';
	&MkDirHier($dir);
	&Touch($pwf);
    }

    # perserve the current inode $mode
    my ($saved_permission) = (stat($pwf))[2];

    print STDERR "\% $prog $flag $pwf $user\n";
    if ($flag) {
	&__system($prog, $flag, $pwf, $user);
    }
    else {
	&__system($prog, $pwf, $user);
    }

    # reset inode $mode
    chmod $saved_permission, $pwf;
}


sub do_info
{
    $| = 1;

    my ($use_pager) = 0;
    if ($ENV{'PAGER'}) {
	if (open(STDOUT, "| $ENV{'PAGER'} ")) {
	    $use_pager = 1;
	}
	else {
	    &Error("fail to open $ENV{'PAGER'}");
	}
    }
    print "*" x 60; print "\n";
    print "makefml Usage:\n\n";
    print "             makefml command\n";
    print "             makefml command <ML>  options\n";
    print "             makefml <ML>::command options\n";
    print "\n";

    printf "   makefml %-25s %s\n", "command arguments", "what";
    print "   ".("-"x57)."\n\n";

    for (sort {$a <=> $b} keys %MakeFmlProc) {
	next unless /^\d+\#/;
	$usage = $MakeFmlProc{$_};

	s/^(\d+\#)//;

	printf "   makefml %-25s %s\n", $_, $usage;
    }

    print "\n";
    print "*" x 60; print "\n";
    print "\n";
    print "HOW TO INSTALL:\n";
    print "\"perl makefml install\" to install fml\n";
    print "\"perl makefml -W cgi install\" to enable cgi for fml\n";
    print "\"perl makefml config <ML>\" to go to the menu screen\n";
    print "\n";

    if ($use_pager) { close(STDOUT);}
}


sub do_install
{
    local($cmd);

    # dummy for silent screen
    $UnderInstall = 1;
    $MAKEFML_LOGFILE = "./install.log";
    &Touch($MAKEFML_LOGFILE);

    if ($Env ne 'CUI') {
	&Error("installation runs only on shell");
    }

    # main proc -> here;
    &InitFmlConfig;

    # initialize
    $NOT_CHECK_ML_EXIST = 1;

    # do_init
    {
	&ResetVariables;

	print "   mkdir $EXEC_DIR\n";
	&Mkdir($EXEC_DIR, 0755);		

	print "   mkdir $ML_DIR\n";
	&MakeWritableDir($ML_DIR);
    }

    # installation: -f config file 
    if (-f $opt_f && -f $FML_CONFIG) {
	$cmd = "y";
    }
    else {
	$cmd = &Query("---Install the Fml system to $CurConfig{'EXEC_DIR'}.", 
		      "y/n", "y|n", "y", 1);
    }

    if ($cmd ne 'y') {
	print "STOP. (DO NOT INSTALLED)\n";
	return;
    }
    else {
	print "Installing fml system to $Config'EXEC_DIR\n"; #';
    }


    ### Fixing perl path ###
    {
	print STDERR "Fixing Path:";

	print STDERR " src ";
	&FixPath("src/default_config.ph"); print STDERR ".";
	for (<src/*.pl>){ &FixPath($_); print STDERR ".";}
	
	print STDERR " libexec ";
	for (<libexec/*.pl>){ &FixPath($_); print STDERR ".";}

	print STDERR " sbin ";
	&FixPath("sbin/makefml"); print STDERR ".";

	print STDERR " cf ";
	&FixPath("cf/config"); print STDERR ".";

	# bin/*.pl
	print STDERR " bin ";
	for (<bin/*.pl>){ &FixPath($_); print STDERR ".";}

	print STDERR " www/cgi-bin ";
	for (<www/cgi-bin/*/*.cgi>){ &FixPath($_); print STDERR ".";}
	print STDERR " www/lib ";
	for (<www/lib/*.pl>){ &FixPath($_); print STDERR ".";}

	print STDERR " sys ";
	for (<sys/*/*.pl>){ &FixPath($_); print STDERR ".";}

	print STDERR " module ";
	for (<module/*/*.pl>){ &FixPath($_); print STDERR ".";}

	print STDERR "\n\tDone.\n";
    }

    &ResetVariables;

    # /var/spool/ml/etc/
    # etc can be group-writable for crontab/each-user
    if ($GroupWritable) {
	print STDERR "Group Writable\n" if $debug;
	print STDERR "mkdir $ML_ETC_DIR\n" if $debug;;
	&MakeWritableDir($ML_ETC_DIR);
    }
    else {
	print STDERR "Personal Use\n" if $debug;;
	print STDERR "mkdir $ML_ETC_DIR\n" if $debug;;
	&MakeWritableDir($ML_ETC_DIR);
    }

    print STDERR "\nGenerate nroff manuals:\n";
    for $f (<doc/man/*.?>) {
	&Copy($f, "$f.bak");
	&Conv('elena', "$f.bak", $f);
    }
    print STDERR "\n";

    # $EXEC_DIR/sbin/install.sh is NOT yet installed 
    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	&Log("makefml windows NT4 mode");
	print "perl sys/WINDOWS_NT4/ntinstall.pl $EXEC_DIR\n";

	system "$^X sys/WINDOWS_NT4/ntinstall.pl $EXEC_DIR";

	# What is "nfml" ??? :D < fukachan@fml.org 
	&Conv("nfml", "sys/WINDOWS_NT4/makefml.cmd", 
	      "$EXEC_DIR/makefml.cmd");
    }
    elsif (-f "sbin/install.sh") {
	$SH = $ENV{'SH'} || "/bin/sh";
	system "$SH ./sbin/install.sh " . DestDir($EXEC_DIR);
	eval symlink($CONFIG_DIR, DestDir("$EXEC_DIR/Configurations"));
	&main'Warn($@) if $@; #';
    }
    else {
	print "Please do \"makefml\" in the top directory of the source\n";
    }

    # disable .crc in installation mode
    undef $CHECK_SUM;
    &MakeConfigPH(DestDir("$EXEC_DIR/cf/config"),
		  DestDir("$EXEC_DIR/cf/MANIFEST"), 
		  "", DestDir("$EXEC_DIR/default_config.ph"));

    if ($GroupWritable eq 'fmlserv') {
	$cmd = &Query("Set up \"fmlserv\" system now? ", "y/n", "y|n", "n", 1);
	if ($cmd eq 'y') { &ExecCmd("fmlserv");}
    }

    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	;
    }
    else {
	&FYI;
    }

    # CFVersion 2
    # &FYIPolicy;

    if ($COMPAT_ARCH eq "WINDOWS_NT4" && $VENDOR ne "METAINFO") {
	require "$EXEC_DIR/sys/$COMPAT_ARCH/depend.pl";
	require "$EXEC_DIR/sys/$COMPAT_ARCH/makefml.pl";
	&PopFmlSetUp;
    }

    # cgi mode
    if ($CGIInstallMode) {
	&SetUpCGIadmin('install');
    }
}


sub do_setq
{
    #print STDERR "setq \$Config'$_[0] = '$_[1]';\n"  if $debug;;
    eval("\$Config'$_[0] = '$_[1]';");
    eval("\$FML_Config'$_[0] = '$_[1]';");
    &main'Warn($@) if $@; #';
}


sub GenerateDirectory
{
    local($ml) = @_;

    ### umask;
    $NOT_CHECK_ML_EXIST = 1;
    &ResetVariables;
    $NOT_CHECK_ML_EXIST = 0;

    ### mkdir ML Directory
    # group writable;
    # etc, etc/crontab can be group-writable for crontab/each-user
    if ($GroupWritable) {
	print STDERR "Group Writable\n"  if $debug;;
	print STDERR "mkdir etc crontab\n" if $debug;;
	&MakeWritableDir($ML_ETC_DIR);
	&MakeWritableDir("$ML_ETC_DIR/crontab");
	&MakeWritableDir("$ML_ETC_DIR/fml");
    }
    else {
	print STDERR "Personal Use\n" if $debug;;
	print STDERR "mkdir etc crontab\n" if $debug;;
	&MakeWritableDir($ML_ETC_DIR);
	&MakeWritableDir("$ML_ETC_DIR/crontab");
	&MakeWritableDir("$ML_ETC_DIR/fml");
    }

    # THIS ROUTINE IS CALLED IN THE CREATION OF A NEW ML!
    # dup check
    if (-d "$ML_DIR/$ml" && (!$EnForceMode)) {
	&Error("$ml already exists");
	return "FATAL";
    }

    # owner only read-write
    # umask(077);
    &MakeDir("$ML_DIR/$ml");

    # required for further flock but need and can not reflect 
    # config.ph you change in this stage.
    &MakeSubDir("$ML_DIR/$ml/spool"); 
}


sub do_new { &do_newml(@_);}
sub do_newml
{
    local($ml) = @_;
    local($cf, $local_config, $config, @config, %config);

    if (! $ml) {
	&Log("ERROR: makefml::newml ML is not defined");

	&Debug("*** ERROR: no arguments ***");
	&Debug("Please define ML(mailing-list) arguments");
	&Debug("\n\tmakefml newml ML\n");
	$XStatus = 'ERROR: makefml.ml_is_not_defined';
	return;
    }

    if ($UNISTD) {
	&WarnYourAreRoot if $< == 0;
    }
    elsif ($ENV{'USERNAME'} eq 'Administrator') {
	&WarnYourAreRoot;
    }

    print "---Creating $ml mailing list\n";

    # &ApplyPolicy;

    local($status);
    $status = &GenerateDirectory($ml);
    return if $status eq 'FATAL';
    &ResetVariables;
    
    print STDERR "---Generting configuration examples.\n";

    ### cf file; 
    # &SetWritableUmask; &SetPublicUmask;
    &SetPersonalUmask;	# umask 077;

    if (-f "$ML_DIR/etc/makefml/cf") {
       &Conv($ml, "$ML_DIR/etc/makefml/cf", "$ML_DIR/$ml/cf");
    }
    else {
       &Conv($ml, "$EXEC_DIR/etc/makefml/cf", "$ML_DIR/$ml/cf");
    }

    if (($OS_TYPE || $CPU_TYPE_MANUFACTURER_OS)
	 && open(CF, ">> $ML_DIR/$ml/cf")) {
	# CFVersion 2;
	# $MAKE_FML{'NON_PORTABILITY'} = 1;
	# $MAKE_FML{'CPU_TYPE_MANUFACTURER_OS'} = $CPU_TYPE_MANUFACTURER_OS;

	$MAKE_FML{'OS_TYPE'} = $OS_TYPE;

	# conversion here; since cf/config can be overwrittern 
	# 1998/04/26 removes here
	if (! &Grep("^LOCAL_CONFIG", "$ML_DIR/$ml/cf")) {
	    &OutPutLocalConfig(*MAKE_FML);
	}

	# cf template's LOCAL_CONFIG
	# print CF $CF_TEMPLATE_LOCAL_CONFIG;
	# print CF "\n";

	close(CF);
    }
    else {
	print STDERR "\n";
	print STDERR "\$OS_TYPE NOR \$CPU_TYPE_MANUFACTURER_OS NOT DEFINED\n";
	print STDERR "STOP!\n";
	return;
    }

    ### cf fixed
    if ($MAIL_LIST_MODE) {
	$cf = "$ML_DIR/$ml/cf";
	# set %config, eval %MAKE_FML in it;
	&GetCF($cf, $ml, *config, *cur_config); 
	$MAKE_FML{"DELIVERY_MODE"} = $MAIL_LIST_MODE;
	print STDERR "MODE $MAKE_FML{'DELIVERY_MODE'}\n";
	&SaveCF($cf, *config);
    }

    &ResetVariables;
    &SetPublicUmask;

    # include file is public readable;
    # why for () fails?;
    &ResetAlignedBuffer;
    print "\n   Generate template files in $ML_DIR/$ml/\n";

    {
	my ($f, $orgf, $newf);
	for $f ("include", "include-ctl", "include-mead",
		"aliases", "Makefile") {
	    if (-f "$ML_ETC_DIR/makefml/$f") {
		$orgf = "$ML_ETC_DIR/makefml/$f";
	    }
	    else {
		$orgf = "$EXEC_DIR/etc/makefml/$f";
	    }
	    $newf = "$ML_DIR/$ml/$f";
	    &Conv($ml, $orgf, $newf);
	}

	&SetPersonalUmask;	# umask 077;

	for $f ("crontab", "fmlwrapper.c") {
	    if (-f "$ML_ETC_DIR/makefml/$f") {
		$orgf = "$ML_ETC_DIR/makefml/$f";
	    }
	    else {
		$orgf = "$EXEC_DIR/etc/makefml/$f";
	    }
	    $newf = "$ML_DIR/$ml/$f";
	    &Conv($ml, $orgf, $newf);
	}
    }


    &FixIncludeHeader;

    $OutBuffer =~ s@$ML_DIR/@@g;
    &PrintAlignedBuffer; 


    # fmlserv (uid != owner ) can read help
    ($GroupWritable eq 'fmlserv') ? umask(027) : umask(077);

    # qmail setup
    &QmailSetUp($ml);

    # here backed to the writable bit == 077 or 007
    &SetWritableUmask;
    &SetPersonalUmask;	# umask 077;

    &GenCrontab;

    &MakeConfigPH("$EXEC_DIR/cf/config", "$EXEC_DIR/cf/MANIFEST", 
		  "$ML_DIR/$ml/cf", "$ML_DIR/$ml/config.ph");

    # we need config.ph existence.
    # drafts -> help,deny,guide,objective
    print STDERR "\n   Create template files for commands (help, guide ...)\n";
    &CreateDocTemplate(*config, $ml);

    if ($COMPAT_ARCH eq "WINDOWS_NT4" && $VENDOR eq "METAINFO") {
	require "$EXEC_DIR/sys/$COMPAT_ARCH/depend.pl";
	require "$EXEC_DIR/sys/$COMPAT_ARCH/metainfo.pl";
	&SetUpForMetaInfoSendmail($ml);
    }
    elsif ($COMPAT_ARCH eq "WINDOWS_NT4") {
	require "$EXEC_DIR/sys/$COMPAT_ARCH/depend.pl";
	require "$EXEC_DIR/sys/$COMPAT_ARCH/makefml.pl";
	&PopFmlInputPasswd($ml);
    }

    # print message;
    # the last info
    if ($debug0) {
	print "\n";
	print "# from '#' to the end of this line is a comment.\n";
	print "# ---------- /etc/aliases example      ----------\n";
	&Cat("$ML_DIR/$ml/aliases"); 
	print "# ---------- /etc/aliases example ends ----------\n";
	print "\n";
    }

    &CollectAliases;

    # always cf is newer than config.ph (against manual edit check)
    &Touch("$ML_DIR/$ml/cf");

    # permission check only on UNIX's
    &PermCheck("$ML_DIR/$ml/include") if $UNISTD; 

    # $XStatus = 'OK:';

    print "\n";
    print "   The next step: update your MTA configuration. For example\n";
    print "\t% su root\n";
    print "\t# cat $ML_DIR/$ml/aliases >> /etc/aliases\n";
    print "\t# newaliases\n";
    print "\n   FYI: See templates in '$ML_DIR/$ml/'\n";
}


sub do_destructml
{
    local($ml) = @_;
    local($cf, $local_config, $config, @config, %config);

    if (! $ml) {
	&Log("ERROR: makefml::destructml ML is not defined");

	&Debug("*** ERROR: no arguments ***");
	&Debug("Please define ML(mailing-list) arguments");
	&Debug("\n\tmakefml destructml ML\n");
	$XStatus = 'ERROR: makefml.ml_is_not_defined';
	return;
    }

    local($old, $new) = ("$ML_DIR/$ml", "$ML_DIR/\@$ml");

    if (rename($old, $new)) {
	print STDERR "\trenamed $old to $new (disabled).\n";
	print STDERR "\tPlease run \"rm -fr $new \" to remove it really.\n";

	&CollectAliases;
    }
    else {
	&Error("cannot rename $old $new");
    }
}


sub do_create_doc_template
{
    local($ml) = @_;
    local(%config, %cur_config, $cf);

    &ResetVariables;
    &CreateDocTemplate(*config, $ml);
}


sub CreateDocTemplate
{
    local(*config, $ml) = @_;

    # require overwrite %*config (?)
    local($x, $cf, %config, %cur_config);

    &ResetVariables;
    &ResetAlignedBuffer;

    $cf = "$ML_DIR/$ml/cf";
    &GetCF($cf, $ml, *config, *cur_config); 

    # not exists in the first time
    if (-f "$ML_DIR/$ml/config.ph") {
	&GetConfigPH($ml); # Value() extracts this value.

	# overwrite %config by evaled (config.ph) values.
	# since cf has raw value e.g. elena@$DOMAINNAME, so we need to eval it.
	for $x (keys %config) {
	    $config{$x} = &Value($x) || $config{$x};
	}
    }

    # <Command Trap Keyword>
    # In 'newml', we have no knowledge so that 
    # this ML is compatible mode or not. 
    if ($config{'MAIL_LIST'}) {
	if ($config{'MAIL_LIST'} eq $config{'CONTROL_ADDRESS'} ||
	    $config{'MAIL_LIST_ACCEPT_COMMAND'}) {
	    &Log("\$CTK = '#';"); 
	    $CTK = '#'; 
	}
    }

    # back up 
    for $x ("help", "help-admin", "deny", "guide", 
	"welcome", "confirm", "objective") {
	if (-f "$ML_DIR/$ml/$x") {
	    &Copy("$ML_DIR/$ml/$x", "$ML_DIR/$ml/$x.bak");
	}

	if (-f 	"$ML_ETC_DIR/fml/drafts/$LANGUAGE/$x") {
	    &Conv($ml, "$ML_ETC_DIR/fml/drafts/$x", "$ML_DIR/$ml/$x");
	}
	else {
	    &Conv($ml, "$EXEC_DIR/drafts/$x", "$ML_DIR/$ml/$x");
	}
    }
    
    &PrintAlignedBuffer;
}


sub do_qmail_setup
{
    local($ml) = @_;
    local($cf, $local_config, $config, @config, %config);

    if (! $ml) {
	&Log("ERROR: makefml::newml ML is not defined");

	&Debug("*** ERROR: no arguments ***");
	&Debug("Please define ML(mailing-list) arguments");
	&Debug("\n\tmakefml newml ML\n");
	return;
    }

    &QmailSetUp($ml);
}


sub QmailSetUp
{
    local($ml) = @_;
    &ResetVariables;

    # directory
    local($mf) = "$EXEC_DIR/etc/makefml";
    local($qmail_dir, $qmail_alias_dir, $qmail_users_dir);
    $qmail_dir = "$ML_ETC_DIR/qmail";
    $qmail_alias_dir = "$ML_ETC_DIR/qmail/alias";
    $qmail_users_dir = "$ML_ETC_DIR/qmail/users";

    # direcotries
    # need examples for group
    $GroupWritable ? umask(007) : umask(077); 
    for ($qmail_dir, $qmail_alias_dir, $qmail_users_dir) {
	&MakeWritableDir($_) unless -d $_;
    }

    # setmask
    umask(022);

    &ResetAlignedBuffer;
    print "\n   Generate qmail template files in $qmail_alias_dir/\n";

    # Generating etc/.qmail*
    &Conv($ml, "$mf/dot-qmail", "$qmail_alias_dir/.qmail-$ml");
    &Conv($ml, "$mf/dot-qmail-ctl", "$qmail_alias_dir/.qmail-$ml-ctl");
    &Conv($ml, "$mf/dot-qmail-default", "$qmail_alias_dir/.qmail-$ml-default");

    &GobbleAlignedBuffer(".qmail-$ml-admin");
    &Write2($USER, "$qmail_alias_dir/.qmail-$ml-admin");

    &GobbleAlignedBuffer(".qmail-$ml-request");
    &Write2($USER, "$qmail_alias_dir/.qmail-$ml-request");

    &GobbleAlignedBuffer(".qmail-owner-$ml");
    &Write2($USER, "$qmail_alias_dir/.qmail-owner-$ml");

    &GobbleAlignedBuffer(".qmail-owner-$ml-ctl");
    &Write2($USER, "$qmail_alias_dir/.qmail-owner-$ml-ctl");

    &PrintAlignedBuffer;
    &ResetAlignedBuffer;

    # WINDOWS_NT4
    if ((!$HAS_GETPWUID) && (!$HAS_GETPWGID)) {
	print STDERR "On NT4, we do not gerenate qmail/users/assign.\n";
	return $NULL;
    }


    # /var/qmail/users/assign
    ($GroupWritable eq 'fmlserv') ? umask(002) : umask(022);

    # if (! &Grep("\\+:$USER", "$qmail_users_dir/assign")) {
    {
	print STDERR "\n   Update $qmail_users_dir/assign\n";

	local($uid, $gid);
	$uid = (getpwuid($<))[2] || 65535;
	$gid = (getpwuid($<))[3] || 65535;

	open(IN, "$qmail_users_dir/assign") || 
	    &Log("cannot open $qmail_users_dir/assign");
	open(OUT, "> $qmail_users_dir/assign.new.$$") || 
	    	    &Log("cannot open $qmail_users_dir/assign.new.$$");
	select(OUT); $| = 1; select(STDOUT);

	while (<IN>) {
	    next if /^\.$/;
	    print OUT $_;
	}
	close(IN);

	if (! &Grep('\+:', "$qmail_users_dir/assign")) {
	    print OUT "+:$USER:$uid:$gid:$qmail_alias_dir:-::\n";
	}

	if (! &Grep('\+owner:', "$qmail_users_dir/assign")) {
	    print OUT "+owner:$USER:$uid:$gid:$qmail_alias_dir:-:owner:\n";
	}

	if (! &Grep("\\+$ml\\-:", "$qmail_users_dir/assign")) {
	    print OUT "+$ml:$USER:$uid:$gid:$qmail_alias_dir:-:$ml:\n";
	}
	print OUT ".\n";
	close(OUT);

	rename("$qmail_users_dir/assign.new.$$", "$qmail_users_dir/assign")
	    || &Log("cannot rename assign.new.$$ assign");
    }

    &QmailSetUpByVirtualDomains($ml);
}


# Descriptions: create ~/.qmail-$domain-$ml{,*} by using
#               /var/qmail/control/virtualdomains 
#    Arguments: STR($ml)
# Side Effects: create ~/.qmail-$domain-$ml{,*}
# Return Value: none
sub QmailSetUpByVirtualDomains
{
    local($ml) = @_;

    &ResetVariables;

    my $domain   = $DOMAIN; $domain =~ s/\./:/g;
    my $pathtmpl = "$HOME/.qmail-$domain-$ml";

    print "\n   Generate qmail template files in $HOME\n";

    # Generating etc/.qmail*
    &Conv($ml, "$mf/dot-qmail",         $pathtmpl);
    &Conv($ml, "$mf/dot-qmail-ctl",     $pathtmpl . "-ctl");
    &Conv($ml, "$mf/dot-qmail-default", $pathtmpl . "-default");

    # &GobbleAlignedBuffer(".qmail-$domain-$ml-admin");
    &Write2($USER, "$pathtmpl-admin");

    # &GobbleAlignedBuffer(".qmail-$domain-$ml-request");
    &Write2($USER, "$pathtmpl-request");

    # &PrintAlignedBuffer;
    &ResetAlignedBuffer;

    print "\tYou need the following rule in /var/qmail/control/virtualdomains\n";
    print "\tto use $HOME/.qmail-$domain-* files\n";
    print "\t$DOMAIN:$USER-$DOMAIN\n";
}


sub do_test
{
    local($ml) = @_;
    local($cf);

    print "---Testing $ml mailing list ... \n" if $debug0;

    &ResetVariables;
    &GetTime(time);

    local($input, $exec, $dir);
    $input = "$EXEC_DIR/bin/emumail.pl";
    $exec  = "$EXEC_DIR/fml.pl";
    $dir   = "$ML_DIR/$ml";

    chdir $dir || &Die("cannot chdir ML directory[$dir]\n");
    $SYSTEM_ARGV_IN  = $input;
    $SYSTEM_ARGV_OUT = "$exec $dir $EXEC_DIR -d";
    $SYSTEM_ARGV_QUERY_INPUT = 1;

    local($r);
    $r = &Query("Do you test command mode?", "y/n", "y|n", "n");

    if ($r eq 'y') {
	$SYSTEM_ARGV_OUT .= " --ctladdr";
    }

    print STDERR "test() { $SYSTEM_ARGV }\n" if $debug;
}


# here eval $local_config since here is the phase evaluating CF;
sub GetCF
{
    local($cf, $ml, *config, *cur_config) = @_;
    local($local_config, %uniq, $cf_template);

    # against errors
    $cf = $cf || "$ML_DIR/$ml/cf";

    # template -> @ConfigOrder (with comments)
    $cf_template = "$EXEC_DIR/etc/makefml/cf";

    if (! -f $cf_template) {
	print STDERR "I cannot find $cf_template\n";
	&Exit1;
    }

    open(CFTMP, $cf_template) || 
	&Die("cannot open cf template[$cf_template]");
    while (<CFTMP>) {
	if (/^LOCAL_CONFIG/ .. eof) {
	    next if /^LOCAL_CONFIG/;
	    next if /^\# YOU CAN EDIT MANUALLY AFTER HERE/;
	    next if /^\# configured by \S+makefml/;

	    # skip the first null lines
	    next if (!$CF_TEMPLATE_LOCAL_CONFIG) && /^\s*$/;

	    $CF_TEMPLATE_LOCAL_CONFIG .= $_;
	    next;
	}

	chop;

	if (/^\#/ || /^\s*$/) {
	    push(@ConfigOrder, $_);
	}
	else {
	    ($key, $value) = split(/\s+/, $_, 2);
	    $CFdefined{$key} = 1;
	    push(@ConfigOrder, $key);
	}
    }
    close(CFTMP);

    # local_config defined in cf_template
    $local_config .= $CF_TEMPLATE_LOCAL_CONFIG if $CF_TEMPLATE_LOCAL_CONFIG;

    # set up a buffer in which we eval the current cf
    undef $evalbuf;
    $evalbuf .= qq# \$DIR = \"$ML_DIR/$ml\"; \n#;

    # GET PRESENT CONFIG;
    # without LOCAL_CONFIG;
    open(CF, $cf) || &Die ("cannot open cf[$cf]");
    while (<CF>) {
	next if /^\s*$/;
	chop;

	if (1 .. /LOCAL_CONFIG/) {
	    # required here,not required in the next section;
	    if (/^\#/) { next;}

	    next if /^LOCAL_CONFIG/; # just "cf"(for cf/config) statements;

	    ($key, $value) = split(/\s+/, $_, 2);
	    $config{$key} = $value; # entry can be overwritten;
	    push(@config, $key) unless $uniq{$key}; # entry is unique;
	    $uniq{$key}   = 1;	# unique

	    print STDERR "\$config{$key} = [$value]\n" if $debug;

	    # set up evalbuf to get the current values
	    $value =~ s/@/\\@/g;
	    while ($value =~ s/\\\\@/\\@/g) { 1;}
	    $evalbuf .= qq# \$cur_config{'${key}'} = \"$value\"; \n#;
	}
	else {
	    next if /^LOCAL_CONFIG/;
	    next if /^\# YOU CAN EDIT MANUALLY AFTER HERE/;
	    next if /^\# configured by \S+makefml/;

	    if (/^\#__MAKEFML_LOCAL_CONFIG__/ .. 
		/^\#__END_OF_MAKEFML_LOCAL_CONFIG__/) {
		$local_config .= $_ if /\$MAKE_FML/;
	    }
	    else {
		$USER_DEFINED_LOCAL_CONFIG .= "$_\n";
	    }
	}
    }

    # set up $evalbuf
    eval($evalbuf);
    &main'Warn($@) if $@; #';

    # set local_config -> %MAKE_FML;
    # print $local_config if $debug;
    eval($local_config);
    &main'Warn($@) if $@; #';

    local($v) = $config{"CFVersion"};

    # CFVerion 2 -> 3; Backward Compatilitity 
    if (!$config{"CFVersion"} || 
	$config{"CFVersion"} < 3 ||
	$COMPAT_CF2) {
	&Log("makefml::config convert config.ph::\$CFVersion 2 -> 3");
	&ConvertCF2to3(*config, *MAKE_FML);
    }
    else {
	print STDERR "   (config.ph; \$CFVersion $config{'CFVersion'})\n\n"
	    if $debug;
    }

    if ($config{"CFVersion"} < 3.2) {
	&ConvertCF3to3_1(*config, *MAKE_FML);
    }

    if ($config{"CFVersion"} < 4.1 && (! $CurConfig{'TZ'})) {
	$config{"CFVersion"} = 4.1;
	$config{'TZone'} = '+0900';
    }

    if ($v ne $config{'CFVersion'}) {
	print STDERR "   config.ph: Convert from $v to $config{'CFVersion'}\n";
	$SetProcTitle = "config.ph: Convert from $v to $config{'CFVersion'}";
    }

    # check the validity of ADDR_CHECK_MAX
    if (! $config{'ADDR_CHECK_MAX'}) {
	print STDERR "   cf: lack of ADDR_CHECK_MAX definition!\n";
	print STDERR "   I assume it is 3. Here we go!\n";
	$config{'ADDR_CHECK_MAX'} = 3;
	sleep 3;
    }

    if ($HtmlConfigMode) {
	print "\#\#\# End of HtmlConfigMode Header\n";
    }
}


# XXX 3.0B-TODO
sub GetConfigPH
{
    local($ml) = @_;
    local($status, $config_ph);

    # debug 3.0B new loadconfig
    $debug_30B = 0;

    &ResetVariables;

    $DIR       = "$ML_DIR/$ml";
    $config_ph = "$DIR/config.ph";
    
    if (-f $config_ph) {
	$config_ph'DIR    = $main'DIR;
	@config_ph'LIBDIR = @main'LIDIR;
	@config_ph'INC    = @main'INC;

	# 3.0B-TODO
	package config_ph;
	undef %INC;
	require 'libloadconfig.pl'; 
	eval "&__LoadConfiguration;";
	print STDERR $@ if $@;
	&main'Log($@) if $@; #';
	package main;
    }
    else {
	die("GetConfigPH: $cf does not exists\n");
    }
}


sub Value
{
    local($key) = @_;
    local($v);
    $key || return $NULL;
    print STDERR "\$v = \$config_ph'$key ;\n" if $debug_30B;
    eval("\$v = \$config_ph'$key ;"); #';
    print STDERR $@ if $@;
    $v;
}

# fml 4.0 extension
sub __assymetric_key_maniuplate
{
    my ($mode, $ml, @argv) = @_;

    $NewEncryptionDefaultDir = $NewEncryptionHier = $mode;
    $NewEncryptionHier  =~ s/-/_/g;
    $NewEncryptionHier  =~ tr/a-z/A-Z/;
    $NewEncryptionHier .= "_KEYRING_DIR";

    if ($EncryptionMethodHint =~ /pgp$|pgp2$/i) {
	&do_pgp2($ml, @argv);
    }
    elsif ($EncryptionMethodHint =~ /(pgp5$|pgp[ksve])$/i) {
	my($fp) = $1;
	&do_pgp5($fp, $ml, @argv);
    }
    elsif ($EncryptionMethodHint =~ /gpg/i) {
	&do_gpg($ml, @argv);
    }
    else {
	&Error("unknown \$EncryptionMethodHint = $EncryptionMethodHint");
    }

    undef $NewEncryptionHier;
}
sub do_dist_auth     { &__assymetric_key_maniuplate(    'dist-auth', @_);}
sub do_admin_auth    { &__assymetric_key_maniuplate(   'admin-auth', @_);}
sub do_dist_encrypt  { &__assymetric_key_maniuplate( 'dist-encrypt', @_);}
sub do_admin_encrypt { &__assymetric_key_maniuplate('admin-encrypt', @_);}


# makefml pgp elena PGP-OPTIONS
sub do_pgp2
{
    local($ml, @argv) = @_;
    local($xdir);

    $cf = "$ML_DIR/$ml/cf";
    # set %config, eval %MAKE_FML in it;
    # &GetCF($cf, $ml, *config, *cur_config); 
    &GetConfigPH($ml);

    if ($NewEncryptionHier) {
	print STDERR "\$xdir = &Value($NewEncryptionHier); \n" if $debug;
	$xdir = &Value($NewEncryptionHier);
	$ENV{'PGPPATH'} = $xdir || "$ML_DIR/$ml/etc/$NewEncryptionDefaultDir";
    }
    else {
	$xdir = &Value('PGP_PATH');
	$ENV{'PGPPATH'} = $xdir;
    }

    if ($ENV{'PGPPATH'}) {
	&MkDirHier($ENV{'PGPPATH'}, 0700);
    }
    else {
	&Error("cannot set up PGPPATH");
	return 0;
    }

    $| = 1;
    print "\n--- PGP BEGIN ---\n";
    print "   PGPPATH = $ENV{'PGPPATH'}\n\n";

    &Log("makefml::pgp @argv");
    &__system('pgp',  @argv);
    print STDERR "ERROR: $@" if $@;

    print "\n--- PGP END ---\n\n";

    if ($GroupWritable) {
	chmod 0660, "$xdir/pubring.pgp";	
    }
}


# makefml pgp[ksev] elena PGP-OPTIONS
sub do_pgpk { local($ml, @argv) = @_; &do_pgp5($fp, $ml, @argv);}
sub do_pgps { local($ml, @argv) = @_; &do_pgp5($fp, $ml, @argv);}
sub do_pgpv { local($ml, @argv) = @_; &do_pgp5($fp, $ml, @argv);}
sub do_pgpe { local($ml, @argv) = @_; &do_pgp5($fp, $ml, @argv);}

sub do_pgp5
{
    local($xfp, $ml, @argv) = @_;
    local($xdir);

    $xfp =~ s/do_//;
    
    $cf = "$ML_DIR/$ml/cf";
    # set %config, eval %MAKE_FML in it;
    # &GetCF($cf, $ml, *config, *cur_config); 
    &GetConfigPH($ml);

    if ($NewEncryptionHier) {
	print STDERR "\$xdir = &Value($NewEncryptionHier); \n";
	$xdir = &Value($NewEncryptionHier);
	$ENV{'PGPPATH'} = $xdir || "$ML_DIR/$ml/etc/$NewEncryptionDefaultDir";
    }
    else {
	$xdir = &Value('PGP_PATH');
	$ENV{'PGPPATH'} = $xdir;
    }

    if ($ENV{'PGPPATH'}) {
	&MkDirHier($ENV{'PGPPATH'}, 0700);
    }
    else {
	&Error("cannot set up PGPPATH");
	return 0;
    }

    &Touch("$xdir/pgp.cfg") unless -f "$xdir/pgp.cfg";

    $| = 1;
    print "\n--- PGP BEGIN ---\n";
    print "   PGPPATH = $ENV{'PGPPATH'}\n\n";

    print STDERR "makefml::$xfp @argv\n" if $debug;
    &Log("makefml::$xfp @argv");
    &__system($xfp,  @argv);
    print STDERR "ERROR: $@" if $@;

    print "\n--- PGP END ---\n\n";

    if ($GroupWritable) {
	chmod 0660, "$xdir/pubring.skr";
	chmod 0660, "$xdir/pubring.pkr";
    }
}


sub MkDir { &Mkdir(@_);}
sub Mkdir
{
    &Log("makefml::mkdir $_[0]");

    if ($_[1] ne '') { return &MkDirHier($_[0], $_[1]);}
    &MkDirHier($_[0], $USE_FML_WITH_FMLSERV ? 0770 : 0700);
    if ($USE_FML_WITH_FMLSERV && $SPOOL_DIR eq $_[0]) { chmod 0750, $_[0];}
    if ($USE_FML_WITH_FMLSERV && $GID) { chown $<, $GID, $_[0];}
}


sub MkDirHier
{
    local($path, $mode) = @_;
    local($pat) = $UNISTD ? '/|$' : '\\\\|/|$'; # on UNIX or NT4
    local($dir);

    $dir = DestDir($path);
    while ($dir =~ m:$pat:go) {
	next if (!$UNISTD) && $` =~ /^[A-Za-z]:$/; # ignore drive letter on NT4

	if ($` ne "" && !-d $`) {
	    mkdir($`, $mode || 0777) || do {
		&Log("cannot mkdir <$`>: $!"); 
		return 0;
	    };
	}
    }

    1;
}


sub do_config_template
{
    local($ml)     = '_ML_';
    local($dir)    = "$ML_DIR/$ml";
    local($org_cf) = "$EXEC_DIR/etc/makefml/cf";
    local($tmp_cf) = "$dir/cf";
    local($newdir) = "$ML_DIR/etc/makefml";
    local($new_cf) = "$ML_DIR/etc/makefml/cf";

    if (-d $dir) {
	print STDERR "Oops, $dir EXISTS ALREADY!!!\n";
	print STDERR "Sorry, makefml config-template fails since";
	print STDERR "this command uses \"_ML_\" ML virtually.\n";
	return;
    }
    else {
	# make $ML_DIR/@ (this name MUST NOT EXIST)
	&Mkdir($dir);
	&Mkdir($newdir);
    }

    $UnderConfigTemplate = 1;

    # reset the current $EXEC_DIR/etc/makefml/cf to $ML_DIR/@/cf
    unlink $tmp_cf;
    if (-f $new_cf) {	
       print STDERR "   copy $new_cf to $tmp_cf\n";
       &Copy($new_cf,  $tmp_cf);
    }
    else {
       &Copy($org_cf,  $tmp_cf);
    }

    &do_config($ml);

    if ($debug) {
	$| = 1;
	eval &__system("diff", "-u", $org_cf, $tmp_cf);
    }
    print STDERR "   copy $tmp_cf to $new_cf\n";
    &Copy($tmp_cf, $new_cf);
    $UnderConfigTemplate = 0;

    # clean up
    unlink $tmp_cf, "${tmp_cf}.bak";
    rmdir $dir;
}


sub do_html_config
{
    local($ml, $ptr, @argv) = @_;

    $MakefmlCGI  = $ENV{'SCRIPT_NAME'}; # thttpd, apache
    $MakefmlCGI .= "?ML=$ml&PROC=config";
    $Menu'MakefmlCGI = $main'MakefmlCGI;

    $HtmlConfigMode = 1;
    &do_config($ml, @argv);
    $HtmlConfigMode = 0;
}


sub do_config
{
    local($ml, @argv) = @_;
    local($cf, $local_config, $config, @config, %config);
    local(%saved_config, $t_cf, $t_configph);

    # start;
    print "---Configure $ml mailing list ... \n";

    # Variable Settings;
    &ResetVariables;
    $cf = "$ML_DIR/$ml/cf";

    # if config.ph is newer than cf?
    if (-f $cf && -f "$ML_DIR/$ml/config.ph") {
	if (! &CompareWithCRCCache("$ML_DIR/$ml/config.ph")) {
	    print "\n   *** Warning ***\n";
	    print "   You had manually edited it, isn\'t it?\n\n";
	    print "   \"makefml config\" overwrites config.ph.\n";

	    my($cmd);
	    $cmd = &Query("   Can I overwrite config.ph?", "y/n", "y|n", "n");

	    if ($cmd eq "n") { 
		print "   O.K. makefml stops now.\n\n";
		return;
	    }
	}
    }

    # evaluate "$ML_DIR/$ml/cf";
    # set %config, eval %MAKE_FML in it;
    &GetCF($cf, $ml, *config, *cur_config); 

    # internal use
    $config{'_ML_'} = $ml;
    ($config{'_CA_DOMAIN_'}) = (split(/\@/, $config{'CONTROL_ADDRESS'}))[1];
    

    ### MENU BEGIN ###
    # for log
    %saved_config = %config;

    # menu.conf version
    $MENU = "$EXEC_DIR/etc/makefml/menu.conf";
    &Menu'InitMenu(*config,*MENU,*FP,*QUERY,*NAME,*MAP,*BIND,*CONFIG,*HOOK);#';

    local($menuf) = $MENU.".toggle";
    if (-f $menuf) {
	&Menu'InitMenu(*config,*menuf,*FP,*QUERY,*NAME,*MAP,*BIND,*CONFIG,*HOOK);#';
    }

    # MAIN LOOP 
    if ($HtmlConfigMode) {
	# XXX: html_config is non-interactive for www.
	# XXX: directly jump to the target level.
	&HtmlConfigQuery(*config, $ARGV[2], @argv);
    }
    else {
	&EachLevelQuery(*config, "/");
    }

    ### After Care (Logging) ###
    local($changed_p) = 0;
    for (keys %config) {
	if ($config{$_} ne $saved_config{$_}) {
	    &Log("makefml::config \$${_} \"$saved_config{$_}\" -> \"$config{$_}\"");
	    $changed_p++;
	}
    }

    # XXX: html_config do not need to re-create config.ph
    if ($HtmlConfigMode && (!$changed_p)) {
	print "\n   *** DO NOT RE-GENERATE config.ph (debug) ***\n";
	return;
    }

    local($change_p);
    for ('MAIL_LIST', 'CONTROL_ADDRESS', 'MAIL_LIST_ACCEPT_COMMAND') {
	if ($config{$_} ne $saved_config{$_}) {
	    $change_p = 1;
	}
    }
    $config{'CPU_TYPE_MANUFACTURER_OS'} = $CPU_TYPE_MANUFACTURER_OS;

    # fml 3.0
    local($fml30_helper);
    for ("REJECT_POST_HANDLER", "REJECT_COMMAND_HANDLER") {
	# auto_regist => auto_subscribe
	if (($saved_config{$_} eq 'auto_regist') &&
	    ($config{$_} eq 'auto_subscribe')) {
	    $fml30_helper = 1;
	}
    }

    ### MENU END ###

    # set local_config -> %MAKE_FML;
    # print $local_config;
    $eval = q%eval $local_config;%;
    eval($eval);
    &main'Warn($@) if $@; #';

    if (open(CF, ">> $cf")) {
	close(CF);
	&SaveCF($cf, *config);
    }
    else {
	&Log("ERROR makefml::config cannot save to cf file");
	&Warn("Cannot open cf[$cf]");
	return;
    }

    return if $UnderConfigTemplate;

    # make ml/config.ph
    &MakeConfigPH("$EXEC_DIR/cf/config", "$EXEC_DIR/cf/MANIFEST", 
		  $cf, "$ML_DIR/$ml/config.ph");

    &Log("makefml::config operation ends");

    # touch for (cf is newer than config.ph always when makefml works)
    &Touch($cf);

    # FYI: "config-template" does not need this reconfigure-document
    if ($change_p) {
	local($cmd);
	$cmd = &Query("*** FYI ***".
		      "Hmm... you have changed ML or COMMAND address, ".
		      "have\'nt it?\n".
		      "You need to rewrite addresses or command syntaxes\n".
		      "in documents e.g. help, guide,.. \n".
		      "Do you RE-CREATE THEM (help,guide,welcome,...)?",
		      "y/n", 
		      "y|n", 
		      "y");

	if ($cmd eq "y") {
	    print "--- re-create documents (the backup is file.bak)...\n";
	    &CreateDocTemplate(*config, $ml);
	}
	elsif ($cmd eq "n") { 
	    print "   O.K. makefml DOES NOT re-create documents.\n";
	}
    }

    if ($fml30_helper) {
	local($m);
	$m  = "   --- Caution ---\n";
	$m .= "\nWhen you upgarade fml 2.x to 3.0 ";
	$m .= "and you use 'auto_subscribe', you need\n";
	$m .= "\n   copy 'members' file to 'actives' file\n\n";
	$m .= "Q: Can I copy members to actives ?\n";

	$cmd = &Query($m, "y/n", "y|n", "y");

	if ($cmd eq "y") {
	    &UpgradeTo30($ml);
	}
	elsif ($cmd eq "n") { 
	    print "   O.K. makefml does nothing.\n";
	}
    }
}


sub UpgradeTo30
{
    local($ml) = @_;

    print "   -- copy members to actives ...\n";

    &ResetVariables;
    &Copy("$ML_DIR/$ml/actives", "$ML_DIR/$ml/actives.bak30");
    &Copy("$ML_DIR/$ml/members", "$ML_DIR/$ml/actives");

    print STDERR "      (backup is $ML_DIR/$ml/actives.bak30)\n\n";
    print "   Done.\n   ";
    print "\n";
}


sub do_upgrade
{
    local($ml) = @_;
    local($cf, $ph);

    &ResetVariables;
    $cf = "$ML_DIR/$ml/cf";
    $ph = "$ML_DIR/$ml/config.ph";

    if (&CSGrep('auto_regist', $cf) || &CSGrep('auto_regist', $ph)) {
	print STDERR "   Replace auto_regist with auto_subscribe ... \n";
    }

    if (&CSGrep('auto_regist', $cf)) {
	print STDERR "   -- upgrade $cf\n";
	&Replace($cf, "${cf}.new", 'auto_regist', 'auto_subscribe');
	&Copy($cf, "${cf}.bak30");
	&Copy("${cf}.new", $cf);
	print STDERR "      (backup is $cf.bak30)\n\n";
    }

    if (&CSGrep('auto_regist', $ph)) {
	print STDERR "   -- upgrade $ph\n";
	&Replace($ph, "${ph}.new", 'auto_regist', 'auto_subscribe');
	&Copy($ph, "${ph}.bak30");
	&Copy("${ph}.new", $ph);
	print STDERR "      (backup is $ph.bak30)\n\n";
    }

    &UpgradeTo30($ml);

    # touch cf for 'makefml config'
    &Touch($cf);

    if (-f "$ML_DIR/$ml/actives_is_dummy_when_auto_regist") {
	unlink "$ML_DIR/$ml/actives_is_dummy_when_auto_regist";
    }
}


sub do_edit
{
    local($ml, $f) = @_;
    local($editor, $file);

    if ($ENV{'EDITOR'}) {
	$editor = $ENV{'EDITOR'} || "vi";
    }
    else {
	print "I cannot find EDITOR (Environment variable).\n";
	print "Editor you use(e.g. mule, ng, vi, ed ... default \"vi\") [vi] ";
	$editor = &GetString;
    }

    $editor = $editor || $ENV{'EDITOR'} || "vi";
    $file   = $f ? "$ML_DIR/$ml/$f" : "$ML_DIR/$ml/config.ph";

    print STDERR "\n\t$editor $file\n\n";
    &Log("makefml::edit $editor $file");

    &__system($editor, $file);
    print STDERR "\n\t$editor $file\n\n";

    &Log("makefml::edit operation ends");
}


sub do_edit_template
{
    local($f) = @_;
    local($editor, $file, @master_dir, @dir, @file);

    @dir = ("$EXEC_DIR/drafts/$LANGUAGE", 
	    "$EXEC_DIR/etc/makefml",
	    "$ML_ETC_DIR/fml/drafts/$LANGUAGE",
	    "$ML_ETC_DIR/makefml"
	    );

    if ($f) {
	my ($orgf, $lang, $newf);

	# makefml
	$orgf = "$EXEC_DIR/etc/makefml/$f";
	$newf = "$ML_ETC_DIR/makefml/$f";
	&Mkdir("$ML_ETC_DIR/makefml");

	if (-f $newf) {
	    $file = $newf;
	}
	elsif (-f $orgf) {
	    print STDERR "   create $newf\n";
	    &Copy($orgf, $newf); $file = $newf;
	}

	# drafts
	$lang = $LANGUAGE;
	$orgf = "$EXEC_DIR/drafts/$lang/$f";
	$newf = "$ML_ETC_DIR/fml/drafts/$lang/$f";
	&Mkdir("$ML_ETC_DIR/fml/drafts/$lang");

	if ($file) {
	    ;
	}
	elsif (-f $newf) {
	    $file = $newf;
	}
	elsif ((-f $orgf) && (! -f $newf)) {
	    print STDERR "   create $newf\n";
	    &Copy($orgf, $newf); $file = $newf;
	}

	# check validity of the file
	if (-f $file) {
	    print STDERR "   template file is \"$file\"\n\n";
	}
	else {
	    &Error("cannot find $f template");
	    return;
	}
    }
    else {
	&Log("makefml::edit_template cannot find $f");

	print "\nUsage: makefml edit-template TEMPLATE\n";
	print "   Avaiable templates:\n\n";

	my ($dir, %uniq);
	for $dir (@dir) {
	    if (opendir(DIRD, $dir)) {
		for (readdir(DIRD)) {
		    next if /^\./;
		    next if /^\@/;
		    next if /\~$/;
		    next if /\.bak$/;

		    next if $uniq{$_};
		    $uniq{$_} = 1;
		    print "\t$_\n" if -f "$dir/$_";
		}
		closedir(DIRD);
	    }
	}
	print "\n";
	return $NULL;
    }

    if ($ENV{'EDITOR'}) {
	$editor = $ENV{'EDITOR'} || "vi";
    }
    else {
	print "   I cannot find EDITOR (Environment variable).\n";
	print "   Editor you like(e.g. mule, ng, vi, ed ... default \"vi\") [vi] ";
	$editor = &GetString;
    }

    $editor = $editor || $ENV{'EDITOR'} || "vi";

    print STDERR "\n   \"$editor $file\"\n\n"; 
    sleep 1;
    &Log("makefml::edit $editor $file");

    &__system($editor, $file);

    print STDERR "\n   \"$editor $file\" ends\n\n";
    &Log("makefml::edit_template operation ends");
}


sub SetValue
{
    local(*config, $k, $v) = @_;

    $config{$k} = $v;

    if ($debug) {
	print "*" x60; print "\n";
	print "\tset variable \$${k} = $v;\n";
	print "*" x60; print "\n";
    }
}


# XXX: html_config is non-interactive for www.
sub HtmlConfigQuery
{
    local(*config, $top_level, @argv) = @_;
    local($variable, $value) = @argv;

    print "<CENTER>\n";
    print "<H1>fml configuration interface</H1>\n";
    print "</CENTER>\n";
    print "<P><B>Mailing List: $config{'_ML_'}</B>\n";
    print "<HR>\n";

    if (! $VALID_HIER{$top_level}) {
	&Log("ERROR: HtmlConfigQuery: invalid level=$top_level");
	&Error("unknown menu hierarchy level");
	return;
    }

    # Example: variable = SUBJECT_TAG_TYPE, value = 1 (before expansion)
    if ($variable && $value) {
	if ($variable eq 'unknown') {
	    if ($HOOK{$top_level}) {
		print STDERR "\trun hook ...\n";
		eval $HOOK{$top_level};
		&Debug($@) if $@;
		&Log($@) if $@;
		print STDERR "\thook is done.\n";
		sleep 1;
	    }
	    else {
		print "ERROR: invalid request";
	    }
	}
	# XXX toggle variable: yes/no
	elsif ($value eq 'YES') {
	    &SetValue(*config, $variable, 1);
	}
	elsif ($value eq 'NO') {
	    &SetValue(*config, $variable, 0);
	}
	else {
	    # XXX USE POINTER NOT RAW VALUE IN HTML
	    $value = $MAP{$top_level, $value} || $MAP_RAW_VALUE{$top_level, $value};
	    print "<BR>&SetValue(*config, $variable, $value);<BR>\n" if $debug;

	    # XXX: switch type variable: speciail treat for null value
	    if ($value eq '_NULL_') { $value = '';}
	    &SetValue(*config, $variable, $value);
	}
    }

    while ($top_level =~ s|^//|/|) { ;}
    &EvalMenu($top_level, *config, *BIND, *MENU, *COUNT, *MAP, *query);

    print $MENU{$top_level};

    &Menu'GenQuery(*query, $QUERY{$top_level}, $top_level); #';

    local($menu, $query, $pat, $default) = 
	($query{'menu'}, $query{'query'}, 
	 $query{'pat'}, $query{'default'});

    local($v, $ptr, $prev_ptr);
    $v = $CONFIG{$top_level} || 'unknown';
    $prev_ptr = $ptr = $top_level;
    $prev_ptr =~ s#/[^/]+$##;

    if ($debug) {
	print STDERR "
    --- debug ---
    CONFIG{$top_level} => [$v]
    MAP $top_level => [$MAP{$top_level}]
    \$query{'type'} => [$query{'type'}]
    --- debug ---
    ";
    }

    if ($query{'type'} eq 'select') {
	# choice in this menu if $MAP is defined
	if ($MAP{$top_level}) {
	    ; # but we show menu in &Bind;
	}
	# just pointer to next menu
	else {
	    ; # do nothing
	}
    }
    elsif ($query{'type'} eq 'y-or-n') {
	$v   = "VARIABLE=$v";
	print "\t";
	print "\t<A HREF=${MakefmlCGI}&${v}&PTR=$ptr&VALUE=YES>[YES]</A>";
	print "\t<A HREF=${MakefmlCGI}&${v}&PTR=$ptr&VALUE=NO>[NO]</A>";
	print "\n";
	print "<A HREF=${MakefmlCGI}&${v}&PTR=$prev_ptr>[BACK] $prev_ptr</A>\n";
    }
    elsif ($query{"type"} eq "reverse-y-or-n") {
	$v   = "VARIABLE=$v";
	print "\t";
	print "\t<A HREF=${MakefmlCGI}&${v}&PTR=$ptr&VALUE=NO>[YES]</A>";
	print "\t<A HREF=${MakefmlCGI}&${v}&PTR=$ptr&VALUE=YES>[NO]</A>";
	print "\n";
	print "<A HREF=${MakefmlCGI}&${v}&PTR=$prev_ptr>[BACK] $prev_ptr</A>\n";
    }
    elsif ($query{'type'} eq 'number') {
	print "<FORM ACTION=\"$ENV{'SCRIPT_NAME'}\" METHOD=POST>\n";
	print "<INPUT TYPE=hidden NAME=PROC VALUE=config>\n";
	print "<INPUT TYPE=hidden NAME=ML VALUE=$config{'_ML_'}>\n";
	print "<INPUT TYPE=hidden NAME=VARIABLE VALUE=$v>\n";
	print "<INPUT TYPE=hidden NAME=PTR VALUE=$top_level>\n";
	print "<INPUT NAME=VALUE SIZE=10>\n";
	print "<INPUT NAME=submit-p TYPE=submit VALUE=OK>\n";
	print "<INPUT NAME=reset-p  TYPE=reset VALUE=Reset>\n";
	print "</FORM>\n";
	print "<A HREF=${MakefmlCGI}&${v}&PTR=$prev_ptr>[BACK] $prev_ptr</A>\n";
    }
    else {
	
    }
}


sub EachLevelQuery 
{
    local(*config, $top_level) = @_;
    local($r, $clear_prog);

    # "clear" not exist on NT4
    $clear_prog = $UNISTD ? &__SearchPath('clear') : "cls";

    while ($top_level =~ s|^//|/|) { ;}

    $Depth++;

    while (1) {
	$CurTag = "   " x $Depth;

	# required?
	# &Log("makefml::config menu $top_level");

	&EvalMenu($top_level, *config, *BIND, *MENU, *COUNT, *MAP, *query);

	if ($clear_prog) {
	    if (! $debug) {
		&__system($clear_prog) if $TouchCount > 0; $TouchCount++;
	    }

	    print "   ".("*" x 60); print "\n";
	    print "\n";
	    print "\t<<< makefml --- FML Configuration Interface --- >>>\n";
	    print "\t    $SetProcTitle\n" if $SetProcTitle;
	    undef $SetProcTitle;
	    print "\n";
	}
	else {
	    print "   ".("*" x 60); print "\n";
	}

	print $WarnBuf if $WarnBuf; undef $WarnBuf;

	print "   [$Depth $top_level]\n\n" if $debug;
	print $MENU{$top_level};
	print "   ".("*" x 60); print "\n";

	&Menu'GenQuery(*query, $QUERY{$top_level}, $top_level); #';
	&Menu'FixDefault(*query, *config, $top_level);

	$r = &Query($query{'menu'}, $query{'query'}, 
		    $query{'pat'}, $query{'default'});

	if ($query{"type"} eq "y-or-n") {
	    print "--query y/n\n";
	    $v   = $CONFIG{$top_level};
	    &Debug("\$config{$v} = $r eq 1 ? 1 : 0;") if $debug;

	    if ($v) {
		$config{$v} = $r eq "y" ? 1 : 0;
	    }
	    elsif ($r eq 'y' && $HOOK{$top_level}) {
		print STDERR "\trun hook ...\n";
		eval $HOOK{$top_level};
		&Debug($@) if $@;
		&Log($@) if $@;
		print STDERR "\thook is done.\n";
		sleep 1;
	    } 
	    else {
		&Debug("EachLevelQuery(y/n): Error, $v is not defined");
	    }

	    last;
	}
	elsif ($query{"type"} eq "reverse-y-or-n") {
	    print "--query y/n\n";
	    $v   = $CONFIG{$top_level};
	    &Debug("\$config{$v} = $r eq 1 ? 1 : 0;") if $debug;

	    if ($v) {
		$config{$v} = $r eq "y" ? 0 : 1;
	    }
	    else {
		&Debug("EachLevelQuery(y/n): Error, $v is not defined");
	    }

	    last;
	}
	elsif ($query{"type"} eq "string") {
	    print "--query y/n\n";

	    $v   = $CONFIG{$top_level};
	    $config{$v} = $r;
	    &Debug("string input> $v => $r");

	    last;
	}
	elsif ($query{"type"} eq "number") {
	    print "--query y/n\n";

	    $v   = $CONFIG{$top_level};
	    $config{$v} = $r;
	    &Debug("string input> $v => $r");

	    last;
	}
	elsif (($r == 0) && 
	       ($query{"type"} eq "select" ||
		$query{"type"} eq "select-direct-map")) {
	    last;
	}
	else {
	    $lvl = $BIND{$top_level, $r};

	    # check in the current level
	    # set the value
	    if ($v = $CONFIG{$top_level}) {
		$config{$v} = 
		    $MAP{$top_level, $r} ne "" ? $MAP{$top_level, $r} : $r;

		# $NULL => ""
		$config{$v} =~ s/\$NULL//; 
		$config{$v} =~ s/_NULL_//; 

		undef $config{$v} if $config{$v} eq "_NULL_";
	    }
	    else {
		&EachLevelQuery(*config, "$top_level/$lvl");
	    }
	}
    }

    $Depth--;
}


sub SaveCF
{
    local($cf, *config) = @_;
    local(%uniq);

    # fix
    if ($UnderConfigTemplate) {
	; # cf template replacement should not be done.
    }
    else {
	$config{'CPU_TYPE_MANUFACTURER_OS'} = $CPU_TYPE_MANUFACTURER_OS;

	if ($config{'STRUCT_SOCKADDR'}) {
	    print STDERR "---use STRUCT_SOCKADDR (cache)\n" if $debug;
	}
	else {
	    print STDERR "---use STRUCT_SOCKADDR (no cache)\n" if $debug;
	    &SetSockAddr($CPU_TYPE_MANUFACTURER_OS);
	    $config{'STRUCT_SOCKADDR'} = $STRUCT_SOCKADDR;
	}
    }

    if (open(CF, "> ${cf}.new")) {
	select(CF); $| = 1; select(STDOUT);

	# believe the config conservation
	# undef $config{'NON_PORTABILITY'};
	# undef $config{"COMPAT_$OS_TYPE"};

	if (! $UnderConfigTemplate) {
	    print CF "\# $MailDate(configured by $0)\n\n";
	}

	# configurable variable <=> %config entries;
	push(@config, keys %config);
	&Uniq(*config);

	for (@ConfigOrder, @config) {
	    if (/^\#/ || /^\s*$/) {
		print CF "$_\n";
		next;
	    }

	    next if $uniq{$_}; $uniq{$_} = 1;

	    print STDERR "-config: $_\n" if $debug;

	    # skip internal and obsolete entries
	    next if /^_\S+_/; # internal use variables e.g. _ML_
	    next if $_ eq 'NON_PORTABILITY';
	    next if $_ eq "COMPAT_${OS_TYPE}";

	    # may be 0 is true value ($debug = 0);
	    printf CF "%-25s\t%s\n", $_, $config{$_};
	    undef $config{$_};
	}

	# CFVersion 2;
	# $MAKE_FML{'OS_TYPE'}         = $OS_TYPE;
	# $MAKE_FML{'NON_PORTABILITY'} = 1;
	# $MAKE_FML{'CPU_TYPE_MANUFACTURER_OS'} = $CPU_TYPE_MANUFACTURER_OS;

	&OutPutLocalConfig(*MAKE_FML);
	close(CF);

	if (-s "${cf}.new") {
	    &Copy($cf, "${cf}.bak");
	    if (rename("${cf}.new", $cf)) {
		print "   Configuration is saved in ${cf}.\n";
	    }
	    else {
		&Error("cannot save $cf");
		print "   Configuration is not saved in ${cf}.\n";
	    }
	}
    }
}

sub Uniq
{
    local(*config) = @_;
    local(@new, %uniq);

    for (@config) {
	push(@new, $_) unless $uniq{$_}; 
	$uniq{$_} = 1;
    }
    @config = @new;
}

sub Grep
{
    local($key, $file) = @_;

    open(GREP_IN, $file) || 
	(&Log("Grep: cannot open file[$file]"), return $NULL);
    while (<GREP_IN>) { return $_ if /$key/i;}
    close(GREP_IN);

    $NULL;
}

sub CSGrep
{
    local($key, $file) = @_;

    open(CSGREP_IN, $file) || 
	(&Log("Grep: cannot open file[$file]"), return $NULL);
    while (<CSGREP_IN>) { return $_ if /$key/;}
    close(CSGREP_IN);

    $NULL;
}

sub Replace
{
    local($in, $out, $key, $newkey) = @_;
    local($mode) = (stat($in))[2];

    open(COPY_IN,  $in) || (&Log("ERROR: Copy < $in [$!]"), return 0);
    open(COPY_OUT, "> $out") || (&Log("ERROR: Copy > $out [$!]"), return 0);
    select(COPY_OUT); $| = 1; select(STDOUT); 
    chmod $mode, $out;

    while (<COPY_IN>) {
	s/$key/$newkey/g;
	print COPY_OUT $_;
    }

    close(COPY_OUT);
    close(COPY_IN);

    1;
}

sub PerlModuleExistP
{
    local($pm) = @_;
    if ($] !~ /^5\./) { &Log("ERROR: using $pm requires perl 5"); return 0;}
    eval("use $pm");
    if ($@) { &Log("${pm}5.pm NOT FOUND; Please install ${pm}.pm"); return 0;}
    1;
}

# XXX 3.0B-TODO: nothing to do.
sub MakeConfigPH
{
    local($config, $manifest, $cf, $config_ph, $preamble) = @_;

    if ($cf) {
	print STDERR "\n   Create config.ph($config_ph):\n";
	print STDERR "\t$cf  ->  config.ph ... ";
    }

    for ($config, $manifest, $cf) { # config.ph may not exist; 
	if ($_ && ! -e $_) {
	    print STDERR "***ERROR: I Cannot find $_, Stop.\n";
	    return $NULL;
	}
    }

    $cf = $cf || "-i";

    &TweakPath;

    if (! open(EXEC_CF, "$^X $config -m $manifest $cf|")) {
	&Log("ERROR: cannot exec $config -m $manifest $cf");
	&Warn("cannot exec $config -m $manifest $cf");
	return $NULL;
    }

    # backup
    local($back_up) = 0;
    if (-f $config_ph) {
	if (&Copy($config_ph, "$config_ph.bak")) { $back_up = 1;}
	# disabled by fukachan (2000/06/19)
	# if ($COMPAT_ARCH eq "WINDOWS_NT4") { unlink $config_ph;}
    }

    # write
    my($new_ph) = $config_ph.".new.$$";
    if (open(SAVE, "> $new_ph")) {
	select(SAVE); $| = 1; select(STDOUT);

	# preamble
	print SAVE $preamble if $preamble;

	while (<EXEC_CF>) { print SAVE $_;}
	close(EXEC_CF);

	close(SAVE);
    }
    else {
	&Log("cannot write $new_ph");
	&Error("cannot write $new_ph");
	unlink $new_ph;
	return $NULL;
    }

    my($status);
    if (&ValidatePerlScriptP($new_ph)) {
	print STDERR "\t(rename($new_ph, $config_ph)\n\t" if $debug;

	# moved here by fukachan (2000/06/19)
	if ($COMPAT_ARCH eq "WINDOWS_NT4") { unlink $config_ph;}

	if (rename($new_ph, $config_ph)) {
	    print STDERR "Done.\n";
	    print STDERR "\t(configuration is backuped in $config_ph.bak)\n"
		if $back_up && (! $UnderInstall);
	}
	else {
	    &Log("cannot make $config_ph");
	    &Error("cannot make $config_ph");
	    &Error("config.ph IS NOT UPDATED.");
	    unlink $new_ph;
	    return $NULL;
	}
    }
    else {
	&Log("$config_ph is broken perl script");
	&Error("$config_ph is broken perl script");
	&Error("config.ph IS NOT UPDATED.");
	unlink $new_ph;
	return $NULL;	
    }

    # warning
    if (-z $config_ph) {
	print STDERR "\n*** ERROR ***\n$config_ph is size 0.\n\n";

	if ($COMPAT_ARCH eq "WINDOWS_NT4") { 
	    print STDERR "failed:";
	    print STDERR "   $^X $config -m $manifest $cf > $config_ph\n\n";
	}
	return $NULL;
    }
    # O.K. !
    else {
	my ($crc, $total) = &TraditionalATTUnixCheckSum($config_ph);
	&Write2("config.ph $crc", $CHECK_SUM) if $CHECK_SUM;
    }

    return 1;
}


sub do_addadmin
{
    $AdminMode = 1;
    &do_adduser(@_);
    $AdminMode = 0;
}


sub do_byeadmin
{
    $AdminMode = 1;
    &do_byeuser(@_);
    $AdminMode = 0;
}


sub do_addactives
{
    $AsymmetricMode = 'actives_only';
    &do_adduser(@_);
    $AsymmetricMode = $NULL;
}


sub do_addmembers
{
    $AsymmetricMode =  'members_only';
    &do_adduser(@_);
    $AsymmetricMode = $NULL;
}


sub do_adduser
{
    local($ml, $member) = @_;
    my (@files, @dbfiles);
    my ($proc) = $fp;
    $proc =~ s/do_//;

    # check the input
    unless (is_valid_user_syntax($member)) {
	&Error("invalid address");
	return 0;
    }

    if (! $ml || !$member) {
	&Log("ERROR: makefml::$proc invalid arguments");
	&Debug("*** SYNTAX ERROR: the number of arguments ***");
	&Debug("\n\tmakefml $proc ML address\n");
	$XStatus = 'ERROR: makefml.invalid_arg';
	return;
    }

    # &GetCF($cf, $ml, *config, *cur_config); 
    &GetConfigPH($ml);

    &SetWritableUmask;

    print "---Adding $member to $ml mailing list\n" if $debug0;

    if ($AdminMode) {
	@files = (&Value('ADMIN_MEMBER_LIST') ||
		  "$ML_DIR/$ml/members-admin");
	push(@dbfiles, 'admin_member_p');
    }
    elsif ($AsymmetricMode) {
	if ($AsymmetricMode eq 'actives_only') {
	    push(@files, (&Value('ACTIVE_LIST') || "$ML_DIR/$ml/actives"));
	    push(@dbfiles, 'active_p');
	    print "   * added to actives (recipients list) only!\n";
	}
	elsif ($AsymmetricMode eq 'members_only') {
	    push(@files, (&Value('MEMBER_LIST') || "$ML_DIR/$ml/members"));
	    push(@dbfiles, 'member_p');
	    print "   * added to members (authentication list) only!\n";
	}
	else {
	    &Error("unknown \$AsymmetricMode");
	}
    }
    else {
	push(@files, (&Value('MEMBER_LIST') || "$ML_DIR/$ml/members"));
	push(@files, (&Value('ACTIVE_LIST') || "$ML_DIR/$ml/actives"))
	    if &UseSeparateListP;
	    push(@dbfiles, 'active_p');
	    push(@dbfiles, 'member_p');
    }

    &ResetVariables;

    # mkdir ML Directory
    if (! -d "$ML_DIR/$ml") {
	&Log("ERROR: makefml::$proc cannot find $ML_DIR/$ml");
	print "\n*****ERROR: $ml ML NOT CREATED\n";
	print "   Firstly,please do \"perl makefml newml $ml\"!\n";
	$XStatus = 'ERROR: makefml.no_such_ml';
	return;
    }

    # add 
    local($fn, $f);
    local($acm) = $ADDR_CHECK_MAX;
    $ADDR_CHECK_MAX = 10;

    if ($config_ph::USE_DATABASE) {
	local($MAIL_LIST, $DATABASE_METHOD, $DATABASE_DRIVER);
	&InitDataBaseAccess($ml);

	for $f (@dbfiles) {
	    my (%mib, %result, %misc, $error);
	    &DataBaseMIBPrepare(\%mib, $f, {'address' => $member});
	    &DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	    if ($mib{'error'}) {
		&Debug("   WARN: skip $fn since $member is already member.");
		&Log("skip $fn since $member is already member");
		&XSWarn("already_subscribed");
		next;
	    }
	    if ($mib{'_result'}) {
		&Debug("   WARN: skip $fn since $member is already member.");
		&Log("skip $fn since $member is already member");
		&XSWarn("already_subscribed");
		next;
	    }
	    if ($f eq 'admin_member_p') {
		&DataBaseMIBPrepare(\%mib, 'addadmin', {'address' => $member});
		&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	    }
	    elsif ($f eq 'member_p') {
		&DataBaseMIBPrepare(\%mib, 'addmembers', {'address' => $member});
		&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	    }
	    elsif ($f eq 'active_p') {
		&DataBaseMIBPrepare(\%mib, 'addactives', {'address' => $member});
		&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	    }
	}
    }
    else {
	for $f (@files) {
	    $fn = $f;
	    $fn =~ s#.*/(\S+)#$1#;

	    # file and member check 
	    &Touch($f) if ! -f $f;
	    if (&CheckMember($member, $f)) {
		&Debug("   WARN: skip $fn since $member is already member.");
		&Log("skip $fn since $member is already member");
		&XSWarn("already_subscribed");
		next;
	    }

	    &Log("makefml::$proc append $member to $fn");
	    print "Append $member to $fn\n" if $debug;
	    &AppendString2File($member, $f);
	}
    }

    # $XStatus = 'OK:';
    $ADDR_CHECK_MAX = $acm;
}


sub do_byeuser
{
    local($ml, $member) = @_;
    my (@files, @dbfiles);
    my ($proc) = $fp;
    $proc =~ s/do_//;

    # check the input
    unless (is_valid_user_syntax($member)) {
	&Error("invalid address");
	return 0;
    }

    if (! $ml || !$member) {
	&Log("ERROR: makefml::$proc invalid arguments");
	&Debug("*** SYNTAX ERROR: the number of arguments ***");
	&Debug("\n\tmakefml $proc ML address\n");
	$XStatus = 'ERROR: makefml.invalid_arg';
	return;
    }

    print "---Delete $member in $ml mailing list\n" if $debug0;

    # &GetCF($cf, $ml, *config, *cur_config); 
    &GetConfigPH($ml);

    &SetWritableUmask;

    # beth: require fix
    if ($AdminMode) {
	@files = (&Value('ADMIN_MEMBER_LIST') ||
		  "$ML_DIR/$ml/members-admin");
	push(@dbfiles, 'admin_member_p');
    }
    else {
	push(@files, (&Value('MEMBER_LIST') || "$ML_DIR/$ml/members"));
	push(@files, (&Value('ACTIVE_LIST') || "$ML_DIR/$ml/actives"))
	    if &UseSeparateListP;
	push(@dbfiles, 'member_p');
    }

    &ResetVariables;

    # mkdir ML Directory
    if (! -d "$ML_DIR/$ml") {
	&Log("ERROR: makefml::$proc cannot find $ML_DIR/$ml");
	print "***ERROR: $ml ML NOT CREATED\n";
	print "   Firstly,please do \"perl makefml newml $ml\"!\n";
	$XStatus = 'ERROR: makefml.no_such_ml';
	return;
    }

    # delete 
    local($file, $found);

    if ($config_ph::USE_DATABASE) {
	local($MAIL_LIST, $DATABASE_METHOD, $DATABASE_DRIVER);
	&InitDataBaseAccess($ml);

	for $file (@dbfiles) {
	    my (%mib, %result, %misc, $error);
	    &DataBaseMIBPrepare(\%mib, $file, {'address' => $member});
	    &DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	    if ($mib{'error'}) {
		&Log("makefml::$proc delete $member in $file");
		print "Delete $member in $file\n" if $debug;

	    }
	    if (!$mib{'_result'}) {
		&Log("makefml::$proc delete $member in $file");
		print "Delete $member in $file\n" if $debug;

		# notify if plural addresses (> 1) has been changed
		print "\tRemoved $found addrs.\n" if $found > 1;
	    }
	    if ($file eq 'admin_member_p') {
		&DataBaseMIBPrepare(\%mib, 'byeadmin', {'address' => $member});
		&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	    }
	    elsif ($file eq 'member_p') {
		&DataBaseMIBPrepare(\%mib, 'unsubscribe', {'address' => $member});
		&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	    }
	}
    }
    else {
	for $file (@files) {
	    if ($found = &RemoveMember($file, $member)) {
		$file =~ s#.*/(\S+)#$1#;
		&Log("makefml::$proc delete $member in $file");
		print "Delete $member in $file\n" if $debug;

		# notify if plural addresses (> 1) has been changed
		print "\tRemoved $found addrs.\n" if $found > 1;
	    }
	}
    }

    # $XStatus = 'OK:';
}

# on, off, chaddr
sub do_off    { &do_ctladdr(@_);}
sub do_on     { &do_ctladdr(@_);}
sub do_chaddr { &do_ctladdr(@_);}
sub do_matome { &do_ctladdr(@_);}
sub do_digest { &do_ctladdr(@_);}
sub do_ctladdr
{
    local($ml, $addr, $opt) = @_;
    my (@files, @dbfiles);
    my ($proc) = $fp;

    # check the input
    unless (is_valid_user_syntax($addr)) {
	&Error("invalid address");
	return 0;
    }

    # canonicalize
    $proc =~ s/do_//;
    $proc =~ tr/A-Z/a-z/; # lower

    if (! $ml || !$addr) {
	&Log("ERROR: makefml::$proc invalid arguments");
	&Debug("*** SYNTAX ERROR: the number of arguments ***");
	&Debug("\n\tmakefml $proc ML address\n");
	$XStatus = 'ERROR: makefml.invalid_arg';
	return;
    }

    if ($proc eq 'chaddr' || $proc eq 'matome' || $proc eq 'digest') {
	if ($opt eq '') { # may be "matome 0"
	    &Log("ERROR: makefml::$proc has no option");
	    &Debug("*** SYNTAX ERROR: makefml::$proc has no option ***");
	    $XStatus = 'ERROR: makefml.syntax_error';
	    return;
	}
    }

    if ($proc eq 'chaddr' && &Value('USE_MEMBER_NAME')) {
	&Debug("*** ERROR ***");
	&Debug("*** If you use \$USE_MEMBER_NAME, please use");
	&Debug("*** \"makefml command $ml $proc addr new-addr\"");
	    $XStatus = 'ERROR: makefml.syntax_error';
    }

    print "---$proc $addr in $ml mailing list\n" if $debug0;

    # &GetCF($cf, $ml, *config, *cur_config);
    &GetConfigPH($ml);

    &SetWritableUmask;

    # files to change
    # XXX 1999/09/25
    # we control actives/both also in "auto_asymmetric_regist" mode,
    # so we should use *SeparateList*() functions.
    if (&NotUseSeparateListP) {
	push(@files, (&Value('MEMBER_LIST') || "$ML_DIR/$ml/members"));
	push(@dbfiles, 'member_p');
    }
    else {
	push(@files, (&Value('ACTIVE_LIST') || "$ML_DIR/$ml/actives"));
	push(@dbfiles, 'active_p');

	if ($proc eq 'chaddr') {
	    push(@files, (&Value('MEMBER_LIST') || "$ML_DIR/$ml/members"));
	    push(@dbfiles, 'member_p');
	}
    }

    &ResetVariables;

    # mkdir ML Directory
    if (! -d "$ML_DIR/$ml") {
	&Log("ERROR: makefml::$proc cannot find $ML_DIR/$ml");
	print "***ERROR: $ml ML NOT CREATED\n";
	print "   Firstly,please do \"perl makefml newml $ml\"!\n";
	$XStatus = 'ERROR: makefml.no_such_ml';
	return;
    }

    # delete 
    local($file, $found);
    if ($config_ph::USE_DATABASE) {
	local($MAIL_LIST, $DATABASE_METHOD, $DATABASE_DRIVER);
	&InitDataBaseAccess($ml);

	$XStatus = '';
	for $file (@dbfiles) {
	    my (%mib, %result, %misc, $error);
	    &DataBaseMIBPrepare(\%mib, $file, {'address' => $addr});
	    &DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	    if ($mib{'error'}) {
		print "\t*** ERROR: Nothing has been changed. ***\n";
		$XStatus = 'ERROR: makefml.nothing_changed';
	    }
	    if (!$mib{'_result'}) {
		print "\t*** ERROR: Nothing has been changed. ***\n";
		$XStatus = 'ERROR: makefml.nothing_changed';
	    }
	}
	if ($XStatus eq '') {
	    if ($proc eq 'chaddr') {
	        &DataBaseMIBPrepare(\%mib, $f, {'address' => $member});
	        &DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	        if ($mib{'error'}) {
		    &Log("$newaddr should not be a member");
	  	    print "\t*** ERROR: Nothing has been changed. ***\n";
		    $XStatus = 'ERROR: makefml.nothing_changed';
	        }
	        if ($mib{'_result'}) {
		    &Log("$newaddr should not be a member");
	  	    print "\t*** ERROR: Nothing has been changed. ***\n";
		    $XStatus = 'ERROR: makefml.nothing_changed';
	        }
	    }
	}
	if ($XStatus eq '') {
	    if ($proc eq 'chaddr' || $proc eq 'matome' || $proc eq 'digest') {
		$mib{'_value'} = $opt;
	    }
	    &DataBaseMIBPrepare(\%mib, $proc, {'address' => $addr});
	    &DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	}
    }
    else {
	for $file (@files) {
	    if ($found = &CtlAddrList($proc, $file, $addr, $opt)) {
		$file =~ s#.*/(\S+)#$1#;
		&Log("makefml::$proc delete $addr in $file");
		print "Delete $addr in $file\n" if $debug;

		# notify if plural addresses (> 1) has been changed
		print "\tChanged $found addrs.\n" if $found > 1;
	    }
	    else {
		print "\t*** ERROR: Nothing has been changed. ***\n";
		$XStatus = 'ERROR: makefml.nothing_changed';
	    }
	}
    }

    # $XStatus = 'OK:';
}


sub NonAutoRegistrableP { ! &AutoRegistrableP;}
sub AutoRegistrableP
{
    local($REJECT_POST_HANDLER)    = &Value('REJECT_POST_HANDLER') || 
	$config{'REJECT_POST_HANDLER'};
    local($REJECT_COMMAND_HANDLER) = &Value('REJECT_COMMAND_HANDLER') ||
	$config{'REJECT_COMMAND_HANDLER'};

    if ($REJECT_POST_HANDLER && $REJECT_COMMAND_HANDLER) {
	print STDERR "REJECT_{POST,COMMAND}_HANDLER is vaild\n" if $debug;
    }
    else {
	print STDERR "ERROR: REJECT_{POST,COMMAND}_HANDLER is invaild\n";
	&Log("ERROR: REJECT_{POST,COMMAND}_HANDLER is invaild");
    }

    if ($REJECT_POST_HANDLER =~ /auto\S+regist/ &&
	 $REJECT_COMMAND_HANDLER eq 'auto_asymmetric_regist') {
	&Log("These HANDLER configuration may not work well");
    }

    if ($Envelope{'mode:ctladdr'} && 
	($REJECT_POST_HANDLER    eq 'auto_asymmetric_regist' ||
	 $REJECT_COMMAND_HANDLER eq 'auto_asymmetric_regist')) {
	"auto_asymmetric_regist";
    }
    elsif ($Envelope{'mode:ctladdr'} && 
	($REJECT_POST_HANDLER    eq 'auto_subscribe' ||
	 $REJECT_COMMAND_HANDLER eq 'auto_subscribe')) {
	"auto_subscribe";
    }
    elsif ($REJECT_COMMAND_HANDLER =~ /auto_regist/i ||
	   $REJECT_COMMAND_HANDLER =~ /auto_subscribe/i ||
	   $REJECT_COMMAND_HANDLER =~ /autoregist/i) {
	$REJECT_COMMAND_HANDLER;
    }
    elsif ($REJECT_POST_HANDLER =~ /auto_regist/i ||
	   $REJECT_POST_HANDLER =~ /auto_subscribe/i ||
	   $REJECT_POST_HANDLER =~ /autoregist/i) {
	   $REJECT_POST_HANDLER;
    }
    else {
	0;
    }
}

sub NotUseSeparateListP { ! &UseSeparateListP;}
sub UseSeparateListP
{
    local($x) = &AutoRegistrableP;

    if ($debug_fml30 == 1) { 
	&Log("AutoRegistrableP = $x"); $debug_fml30++;
    }

    if ($x eq 'auto_subscribe' || (! $x)) {
	1;
    }
    else {
	0;
    }
}


sub do_mead
{
    print "-- prepare mead home directory ... \n" if $debug0;

    # special assigned ML;
    $ml = "mead";

    local($status);
    $status = &GenerateDirectory($ml);
    return if $status eq 'FATAL';
    &ResetVariables;

    ### cf file; 
    &ResetVariables;

    &SetPublicUmask;

    # include file is public readable;
    # why for () fails?;
    local($exec_dir) = "$EXEC_DIR/etc/makefml";

    &Conv($ml, "$exec_dir/include-mead", "$ML_DIR/$ml/include-mead");
    &Conv($ml, "$exec_dir/mead-aliases", "$ML_DIR/$ml/aliases");
    &Conv($ml, "$exec_dir/mead_force.ph", "$ML_DIR/$ml/mead_force.ph.example");

    print "\n";
    print "   The next step: update your MTA configuration. For example\n";
    print "\t% su root\n";
    print "\t# cat $ML_DIR/$ml/aliases >> /etc/aliases\n";
    print "\t# newaliases\n";
    print "\n   FYI: See templates in '$ML_DIR/$ml/'\n";
}


sub do_fmlserv
{
    print "---Configure fmlserv mailing list ... \n" if $debug0;

    # special assigned ML;
    $ml = "fmlserv";

    local($status);
    $status = &GenerateDirectory($ml);
    return if $status eq 'FATAL';
    &ResetVariables;

    ### cf file; 
    &ResetVariables;

    &SetPublicUmask;

    # include file is public readable;
    # why for () fails?;
    local($exec_dir) = "$EXEC_DIR/etc/makefml";

    &Conv($ml, "$exec_dir/fmlserv-include", "$ML_DIR/$ml/include");
    &Conv($ml, "$exec_dir/fmlserv-aliases", "$ML_DIR/$ml/aliases");

    &SetPersonalUmask;
    &Conv($ml, "$exec_dir/fmlserv-fmlwrapper.c",   "$ML_DIR/$ml/fmlwrapper.c");
    &FixIncludeHeader;

    # fmlserv (uid != owner ) can read help
    ($GroupWritable eq 'fmlserv') ? umask(027) : umask(077);

    &Conv($ml, "$EXEC_DIR/drafts/help-fmlserv", "$ML_DIR/fmlserv/help");

    ### config.ph generation
    ### config.ph is fmlserv-specific + ordinary config.ph
    &Conv($ml, "$exec_dir/fmlserv-config.ph", "$ML_DIR/$ml/config.ph");
    ### config.ph ends

    # the last info
    # print "\n   Please see several examples in $ML_DIR/$ml\n";
    # print "\n# Example of Aliases ($ML_DIR/$ml/aliases)\n";
    # &Cat("$ML_DIR/$ml/aliases");
    # print "";
    # print "\n";

    print "\n";
    print "   The next step: update your MTA configuration. For example\n";
    print "\t% su root\n";
    print "\t# cat $ML_DIR/$ml/aliases >> /etc/aliases\n";
    print "\t# newaliases\n";
    print "\n   FYI: See templates in '$ML_DIR/$ml/'\n";
}


sub do_popfml
{
    &ResetVariables;

    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	require "$EXEC_DIR/sys/$COMPAT_ARCH/depend.pl";
	require "$EXEC_DIR/sys/$COMPAT_ARCH/makefml.pl";
	&PopFmlSetUp;
    }
    else {
	print STDERR "Sorry, Unix Version Interface is not yet.\n";
    }
}


sub do_pop_passwd
{
    &ResetVariables;

    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	require "$EXEC_DIR/sys/$COMPAT_ARCH/depend.pl";
	require "$EXEC_DIR/sys/$COMPAT_ARCH/makefml.pl";
	&PopFmlInputPasswd($ml);
    }
    else {
	print STDERR "Sorry, Unix Version Interface is not yet.\n";
    }
}


sub do_lock
{
    local($ml, $timeout, @shell_args) = @_;
    local(@files);
    local($proc) = $fp;
    $proc =~ s/do_//;

    $timeout = $timeout || 3600;

    if (! $ml) {
	&Log("ERROR: makefml::$proc invalid arguments");
	&Debug("*** SYNTAX ERROR: the number of arguments ***");
	&Debug("\n\tmakefml $proc ML address\n");
	&XSWarn("invalid_number_of_argument");
	return;
    }

    print "\n";

    if ($timeout eq '-e') {
	&__system(@shell_args);
    }
    else {
	print "   makefml[$$] succeeded to lock $ml\n";
	print "   I sleep for $timeout seconds after now.\n";
	print "   Please interrupt this by CONTROL-C to stop this lock\n";

	sleep($timeout);
    }
}


sub do_command
{
    local($ml, $member, @arg) = @_;
    local(@files);
    local($proc) = $fp;
    $proc =~ s/do_//;

    if (! $ml || !$member) {
	&Log("ERROR: makefml::$proc invalid arguments");
	&Debug("*** SYNTAX ERROR: the number of arguments");
	&Debug("\n\tmakefml $proc ML address command-strings");
	&Debug("\te.g.");
	&Debug("\tmakefml $proc ML address mget last:100 mp");
	&XSWarn("invalid_number_of_argument");
	return;
    }

    if ($member !~ /\@/) {
	&Log("ERROR: makefml::$proc invalid arguments");
	&Debug("*** SYNTAX ERROR: command ML \"E-Mail Address\" ...");
	return;	
    } 

    if (grep(/admin|approve/, @arg)) {
	&Log("ERROR: makefml::$proc does not emulate 'admin' command");
	&Debug("*** SYNTAX ERROR: $proc doesn't emulate 'admin' command");
	&Debug("***               since authentication is requried");
	return;
    }

    local($command);
    $command =  "$EXEC_DIR/fml.pl $ML_DIR/$ml $EXEC_DIR --ctladdr --makefml";

    # "makefml -m command" send a mail to notify the result to a user.
    if (! $MailNotify) { $command .= " --disablenotify";}

    print STDERR "--- mail to input ---\n";
    print STDERR "From: $member\n";
    print STDERR "Subject: @arg \n";
    print STDERR "\n@arg\n";
    print STDERR "\n";
    print STDERR "--- injected to ---\n";
    print STDERR "> \"| $command \"\n";

    open(COM, "| $command") || &Die("cannot exec [$command]\n");
    select(COM); $| = 1; select(STDOUT);
    print COM "Message-Id: <$$.makefml\@$FQDN>\n";
    print COM "From: $member\n";
    print COM "Subject: @arg \n\n";
    print COM "@arg\n";
    close(COM);
}


sub do_conv
{
    local($ml, $org, $file) = @_;

    print "\tconvert $org to $file ...\n";

    &ResetVariables;
    &SetPublicUmask;
    &Conv($ml, $org, "$ML_DIR/$ml/$file");

    print "done.\n";
}


sub do_update_config_ph
{
    local($ml) = @_;
    &do_update($ml, 'config.ph');
}


sub do_update
{
    local($ml, $file) = @_;
    local($x) = $file;
    local($t, $fail, $target);

    &ResetVariables;

    # file: $x
    $x =~ s#.*/##;
    $target = "$ML_DIR/$ml/$x";

    if ($x eq 'config.ph') {
	print "O.K. Try to re-create $target !!!\n";
	# make ml/config.ph
	my ($status);
	$status = &MakeConfigPH("$EXEC_DIR/cf/config", 
				"$EXEC_DIR/cf/MANIFEST", 
				"$ML_DIR/$ml/cf", 
				"$ML_DIR/$ml/config.ph");
	# sync w/ "make config.ph" behaviour
	# &Touch("$ML_DIR/$ml/cf") if $status;
	return 1;
    }

    if (-f "$EXEC_DIR/etc/makefml/$x") {
	$t = "$EXEC_DIR/etc/makefml/$x";
    }
    elsif ($LANGUAGE eq 'Japanese' || $LANGUAGE eq 'English') {
	if (-f "$EXEC_DIR/drafts/$LANGUAGE/$x") {
	    $t = "$EXEC_DIR/drafts/$LANGUAGE/$x";
	}
    }

    print "\n\ttry to update $ML_DIR/$ml/$file\n";

    if ($t) {
	print "\tconverted from $t\n";
	&Conv($ml, $t, "$ML_DIR/$ml/$x.new");
	if (rename($target, "$target.bak")) {
	    ;
	}
	else {
	    &Log("fail to rename $target $target.bak");
	    $fail = 1;
	}

	if (rename("$target.new", $target)) {
	    print "\trename $target.new $target\n" if $debug0;
	}
	else {
	    &Log("fail to rename $target.new $target");
	    $fail = 1;
	}

	if ($fail) {
	    print "\n   $target is NOT updated\n";
	}
	else {
	    print "\n   $target is updated\n";
	}
    }
    else {
	print "\n";
	print "*** ERROR: I cannot find the template\n";
	print "***        FAILS TO UPDATE $file\n";
	print "\n";
    }

    print "\n";
}


sub do_resend
{
    local($ml, @argv) = @_;

    &ResetVariables;
    &__system("$EXEC_DIR/bin/resend.pl", "-D", "$ML_DIR/$ml",
	      @argv);
}


sub do_log
{
    local($ml, @argv) = @_;
    local($lines, $flag, $all_p, $prog, $file, $pat, $dpat, $cis_p);

    $lines = 10;

    &ResetVariables;
    &GetConfigPH($ml);

    for (@argv) {
	/^-i$/       && ($cis_p = 1);
	/^\-p(\S+)$/ && ($pat = $1);
	/^\-D(\d+)$/ && ($dpat = $1);
	/^\-(\d+)$/  && ($lines = $1);
	/^all$/i     && ($all_p = 1)
    }

    # logfile
    $file = &Value('LOGFILE') || "$ML_DIR/$ml/log";

    # tail options
    $flag = "-$lines" if $lines;

    if ($dpat =~ m@^(\d{4})(\d{2})(\d{2})$@) {
	$pat = sprintf("^%02d/%02d/%02d", (($1 - 1900) % 100), $2, $3);
	print STDERR "rewrite $dpat => $pat\n" if $debug;
    }
    elsif ($dpat) {
	$pat = $dpat;
	print STDERR "rewrite $dpat => $pat\n" if $debug;
    }

    if ($pat) {
	if (open($file, $file)) {
	    while (<$file>) {
		if ($cis_p) {
		    print $_ if /$pat/i;
		}
		else {
		    print $_ if /$pat/;
		}
	    }
	    close($file);
	}
	else {
	    &Error("cannot open $file");
	}
    }
    elsif ($all_p) {
	if (open($file, $file)) {
	    while (<$file>) { print $_;}
	    close($file);
	}
	else {
	    &Error("cannot open $file");
	}
    }
    else {
	if (! open($file, $file)) {
	    &Error("cannot open $file");
	}

	my ($p, $c, $limit, $n);

	$limit = 16;
	$n     = 0;
	LOOP: while ($n++ < $limit) {
	    $p = - 128 * $lines * $n;

	    # back again and count up the number of lines. 
	    seek($file, $p, 2); # is it portable ??? 
	    $c = 0;
	    while (<$file>) { $c++;}
	    last LOOP if $c > $lines;
	}

	#
	# rewind by seek() and show 
	#
	# XXX check seek() works or not by syseek(), apply patch 
	# XXX by Tomoaki MITSUYOSHI <Mitsuyoshi.Tomoaki@ss.anritsu.co.jp>
	# XXX (private communication)
	# XXX We need to know this check is portable over unix and Windows ..
	# 
	# XXX OS portability check:
	# XXX It works on NetBSD 1.5, Debian/linux (2.0.36 base), FreeBSD 4.x
	# 
	# XXX sysseek() is implemented after when ?
	# XXX At least 5.004 supports it.
	#
	my $seekerr = 0;
	eval {
	    sysopen (FORSEEK, $file, O_RDONLY);
	    $seekerr = 1 if !(sysseek (FORSEEK, $p, 2));
	    close (FORSEEK);
	};

	# XXX old style error check but not works well. 
	# XXX try this when sysseek() is not implemented, I wonder. 
	if ($@) { $seekerr = 1 unless seek($file, $p, 2);}

	if (!$seekerr) {
	    seek($file, $p, 2); # is it portable ? probably not portable :<
	    while (<$file>) { $c-- ; last if $c == $lines;}
	    while (<$file>) { print $_;}
	}
	else {
	    seek($file, 0, 0); # rewind it to the top
	    while (<$file>) { print $_;}
	}

	close($file);
    }
}


sub do_setup_admin_cgi_init
{
    my ($action) = @_;

    if ($action) {
	if ($action eq 'update') {
	    &do_setup_admin_cgi_scripts($NULL);
	}
	elsif ($action eq 'config') {
	    &do_admin_cgi_config($NULL);
	}
	else {
	    &Error("unknown action=$action");
	}
    }
    else {
	&Error("Usage: admin.cgi [update|config]");
	print STDERR "Usage:\n        \n";
	print STDERR "      admin.cgi update    remake /admin/*.cgi\n";
	print STDERR "      admin.cgi config    configuration menu\n";
    }
}


sub do_setup_admin_cgi_scripts
{
    local($ml) = @_;

    &ResetVariables;

    &MkDir("$REAL_CGI_PATH/admin", 0755);

    print STDERR " * create $REAL_CGI_PATH/admin/.htaccess\n"
	unless $SilentMode;
    &Conv($NULL, DestDir("$EXEC_DIR/www/etc/dot_htaccess.admin"),
	  DestDir("$REAL_CGI_PATH/admin/.htaccess"));

    print STDERR " * create CGI scripts in $REAL_CGI_PATH/admin/\n   "
	unless $SilentMode;
    
    for $f ("menu.cgi", "makefml.cgi", "mlmenu.cgi",
	    "menubar.cgi", "index.cgi", "newml.cgi", "rmml.cgi") {
	$template = DestDir("$EXEC_DIR/www/cgi-bin/admin/$f");
	$outfile  = DestDir("$REAL_CGI_PATH/admin/$f");
	print STDERR $f, " " unless $SilentMode;
	&Copy($template, $outfile);
	chmod 0755, $outfile;
    }
    print STDERR "\n" unless $SilentMode;
}


sub __Convert2HTPasswd
{
    local($src, $dst) = @_;
    local($new) = "$dst.new.$$";
    local($user, $pwd);

    if (open(SRC, $src)) {
	if (open(DST, "> $new")) {
	    print STDOUT "\n   add the following users as a $ml cgi-admin\n";
	    while (<SRC>) {
		next if /^\#/;
		next if /^\s*$/;
		chop;

		($user, $pwd) = split(/\s+/, $_);
		print DST "${user}:${pwd}\n";
		print STDOUT "      $user\n";
	    }
	    print STDOUT "\n";
	    close(SRC);
	    close(DST);

	    if (! rename($new, $dst)) {
		&Error("cannot rename $new $dst");
	    }
	}
	else {
	    &Error("cannot open $dst");
	}
    }
    else {
	&Error("cannot open $src");
    }
}


sub do_setup_mladmin_cgi_init
{
    my ($ml, $action, @argv) = @_;

    if ($action) {
	if ($action eq 'update') {
	    &do_setup_mladmin_cgi_scripts($ml);
	}
	elsif ($action eq 'config') {
	    &do_admin_cgi_config($ml);
	}
	else {
	    &Error("unknown action=$action");
	}
    }
    else {
	&Error("Usage: admin.cgi [update|config]");
	print STDERR "Usage:\n        \n";
	print STDERR "      mladmin.cgi $ml update    remake /admin/*.cgi\n";
	print STDERR "      mladmin.cgi $ml config    configuration menu\n";
    }
}


sub do_setup_mladmin_cgi_scripts
{
    local($ml) = @_;

    &ResetVariables;

    &SetPublicUmask;
    &MkDir("$REAL_CGI_PATH/ml-admin/$ml", 0755);
    &Mkdir("$CGI_AUTHDB_DIR/ml-admin/$ml", 0755);

    # make .htaccess
    print STDERR " * create $REAL_CGI_PATH/ml-admin/$ml/.htaccess\n";
    &Conv($ml, "$EXEC_DIR/www/etc/dot_htaccess.ml-admin",
	  "$REAL_CGI_PATH/ml-admin/$ml/.htaccess");

    print STDERR " * create CGI scripts for $ml ML\n";
    print STDERR "   in $REAL_CGI_PATH/ml-admin/$ml/\n";
    print STDERR "   ";
    for $f ("menu.cgi", "makefml.cgi") {
	$template = "$EXEC_DIR/www/cgi-bin/ml-admin/$f";
	$outfile  = "$REAL_CGI_PATH/ml-admin/$ml/$f";
	&Conv($ml, $template, $outfile);
	print STDERR "$f ";
	chmod 0755, $outfile;
    }

    local($pwdf, $etcpwd);
    $pwdf   = "$CGI_AUTHDB_DIR/ml-admin/$ml/htpasswd";
    $etcpwd = "$ML_DIR/$ml/etc/passwd";

    &SetPublicUmask;
    &Touch($pwdf);
    chmod 0644, $pwdf;
    print STDERR "\n";
    return ;

    # 1. use www/authdb/
    print "\n";
    if (-f $pwdf) {
	print "   FYI: use $pwdf\n";
	print "        as htpasswd for $ml ML\n";
    }
    # 2. make htpasswd from $DIR/etc/passwd
    elsif (-f $etcpwd) {
	print "   FYI: import $pwdf\n";
	print "        from $etcpwd\n";
	&__Convert2HTPasswd($etcpwd, $pwdf);
    }
    # 3. 
    else {
	print "FYI: no $pwdf !\n";
	print "     please add admin users for $ml ML!\n";
    }

    print "\n   done.\n";
}


# CISCO IOS like commands for convenience :-)
sub do_show
{
    my ($proc, @argv) = @_;
    my (@p) = ('/sbin', '/usr/sbin', '/usr/bin', '/usr/etc');

    if ($proc eq 'version') {
	&do_showconfig();
    }
    elsif ($proc =~ /^int.*/) {
	if (&__SearchPath('ifconfig', @p)) { &__system('ifconfig -a');}
    }
    elsif ($proc eq 'ip') {
	if ($argv[0] eq 'route') {
	    if (&__SearchPath('netstat', @p)) { &__system('netstat -rn');}
	}
	elsif ($argv[0] =~ /^int.*/) {
	    if (&__SearchPath('ifconfig', @p)) { &__system('ifconfig -a');}
	}
    }
    elsif ($proc eq 'diag') {
	if (&__SearchPath('dmesg', @p)) { &__system('dmesg');}
    }
}


sub do_showconfig
{
    local($ml, $want_retval) = @_;
    local($buf);

    &ResetVariables;

    $format = "%-20s   %s\n";
    $rel    = &GetFile("$EXEC_DIR/etc/release_version");
    $rel    =~ s/[\s\n]+$//;

    $buf .= sprintf($format, "fml version:", $rel);
    $buf .= sprintf($format, "installation mode:", $CurConfig{'PERSONAL_OR_GROUP'});
    $buf .= "\n";
    $buf .= sprintf($format, "OS type:", $OS_TYPE);
    $buf .= sprintf($format, "CPU-MANUFACTURER-OS:", $CPU_TYPE_MANUFACTURER_OS);
    $buf .= sprintf($format, "Perl version:", $]);
    $buf .= sprintf($format, "Perl Path:", $^X);
    $buf .= sprintf($format, "\$0:", $0) if $debug;
    $buf .= "\n";


    $buf .= sprintf($format, "MTA:", $NULL);
    $buf .= sprintf($format, "DOMAIN:", $DOMAIN);
    $buf .= sprintf($format, "FQDN:",   $FQDN);
    
    $want_retval ? $buf : do { print $buf;};
}


sub do_send_pr
{
    local($ml) = @_;
    local($buf, $who);

    $format = "%-20s   %s\n";

    &ResetVariables;

    $buf = &do_showconfig($ml, 1);
    $who = $USER .'@'. $DOMAIN; 

    print "---------- fml bug report template ----------\n";
    printf $format, "Template-Version:", "0.8";
    print $buf;
    printf $format, "Email-Address:", $who;
    print "\n";
    printf $format, "Description:";
    print "\n";
    print "\n";
    printf $format, "How-To-Repeat:";
    print "\n";
    print "\n";
    printf $format, "Fix:";
    print "\n";
    print "\n";
}


sub do_collect_aliases
{
    &CollectAliases;
    print "   Don't forget to run newaliases.\n";
}


sub WarnYourAreRoot
{
    local($f) = $fp;
    $f =~ s/do_//;

    &Log("ERROR: makefml::$f you should not run makefml as root.");

    print "************************* WARNING *************************\n";
    print "\n";
    print "    YOU WILL OPERATE A MAILING LIST as ROOT?\n";
    print "    IT IS VERY DANGEROUS!\n";
    print "    YOU SHOULD RUN MAILING LIST AS A NON-PRIVILEGED USER\n";
    print "\n";
    print "***********************************************************\n";
    sleep 10;
}


#################################


sub CheckMember
{
    local($address, $file) = @_;
    local($addr, $has_special_char);

    # more severe check;
    $address =~ s/^\s*//;
    ($addr) = split(/\@/, $address);
    
    # MUST BE ONLY * ? () [] but we enhance the category -> shell sc
    if ($addr =~ /[\$\&\*\(\)\{\}\[\]\'\\\"\;\\\\\|\?\<\>\~\`]/) {
      $has_special_char = 1; 
    }

    open(FILE, $file) || (&Log("ERROR: cannot open $file"), return 0);

  getline: while (<FILE>) {
      chop; 

      if ((!$ML_MEMBER_CHECK) || $SubstiteForMemberListP) { 
	  /^\#\s*(.*)/ && ($_ = $1);
      }

      next getline if /^\#/o;        # strip comments
      next getline if /^\s*$/o; # skip null line
      /^\s*(\S+)\s*.*$/o && ($_ = $1); # including .*#.*

      # member nocheck(for nocheck but not add mode)
      # fixed by yasushi@pier.fuji-ric.co.jp 95/03/10
      # $ENCOUNTER_PLUS             by fukachan@phys 95/08
      # $Envelope{'mode:anyone:ok'} by fukachan@phys 95/10/04
      # $Envelope{'trap:+'}         by fukachan@sapporo 97/06/28
      if (/^\+/o) { 
	  &Debug("encounter + [$_]") if $debug;
	  $Envelope{'trap:+'} = 1;
	  close(FILE); 
	  return 1;
      }

      # for high performance(Firstly special character check)
      if (! $has_special_char) { next getline unless /^$addr/i;}

      # This searching algorithm must require about N/2, not tuned,
      if (1 == &AddressMatch($_, $address)) {
   close(FILE);
    return 1;
      }
  }# end of while loop;

    close(FILE);
    return 0;
}

# sub AddressMatching($addr1, $addr2)
# return 1 given addresses are matched at the accuracy of 4 fields
sub AddressMatching { &AddressMatch(@_);}
sub AddressMatch
{
    local($addr1, $addr2) = @_;

    # canonicalize to lower case
    $addr1 =~ y/A-Z/a-z/;
    $addr2 =~ y/A-Z/a-z/;

    # try exact match. must return here in a lot of cases.
    if ($addr1 eq $addr2) {
	&Debug("\tAddr::match($addr1) { Exact Match;}") if $debug;
	return 1;
    }

    # for further investigation, parse account and host
    local($acct1, $addr1) = split(/@/, $addr1);
    local($acct2, $addr2) = split(/@/, $addr2);

    # At first, account is the same or not?;    
    if ($acct1 ne $acct2) { return 0;}

    # Get an array "jp.ac.titech.phys" for "fukachan@phys.titech.ac.jp"
    local(@d1) = reverse split(/\./, $addr1);
    local(@d2) = reverse split(/\./, $addr2);

    # Check only "jp.ac.titech" part( = 3)(default)
    # If you like to strict the address check, 
    # change $ADDR_CHECK_MAX = e.g. 4, 5 ...
    local($i);
    while ($d1[$i] && $d2[$i] && ($d1[$i] eq $d2[$i])) { $i++;}

    &Debug("\tAddr::match($addr1) { $i >= ($ADDR_CHECK_MAX || 3);}") if $debug;

    ($i >= ($ADDR_CHECK_MAX || 3));
}


################################


sub SetWritableUmask
{
    if ($GroupWritable eq 'fmlserv') {
	umask(007);
    }
    else {
	umask(077);	
    }
}

sub SetPersonalUmask
{
    umask(077);
}

sub SetPublicUmask
{
    umask(022);
}

sub GetGID
{
    local($gid);

    $gid = (getgrnam($_[0]))[2];
    print STDERR "ERROR: No such group '$_[0]'\n" if $gid eq '';
    $gid;
}

sub MakeWritableDir
{
    local($dir) = @_;

    if ($GroupWritable) {	# for backup files
	-d $dir || &Mkdir($dir, 0775);
	chown $<, $GID, $dir if $GID ne '';
	&SetGidBit($dir);
    }
    else {
	-d $dir || &Mkdir($dir, 0755);
	&SetGidBit($dir);
    }
}

sub MakeDir
{
    local($info) = " GID=$GID" if $GID ne '';
    print "---Make Directory ($_[0])\t(UID=$<$info)\n" if $debug0;

    if ($GroupWritable eq 'fmlserv') {	# for backup files
	-d $_[0] || &Mkdir($_[0], 0775);
	chown $<, $GID, $_[0] if $GID ne '';
	&SetGidBit($_[0]);
    }
    else {
	-d $_[0] || &Mkdir($_[0], 0755);
	&SetGidBit($_[0]);
    }

    if ($UNISTD) {
	print "   directory $_[0] is created as UID=$<$info\n";
    }
    else {
	print "   directory $_[0] is created as USER=$ENV{'USERNAME'}\n";
    }
}

sub MakeSubDir
{
    local($info) = " GID=$GID" if $GID ne '';
    print "---Make Directory ($_[0])\t(UID=$<$info)\n" if $debug0;

    if ($GroupWritable eq 'fmlserv') {	# for backup files
	-d $_[0] || &Mkdir($_[0], 0770);
	chown $<, $GID, $_[0] if $GID ne '';
	&SetGidBit($_[0]);
    }
    else {
	-d $_[0] || &Mkdir($_[0], 0700);
    }

    if ($UNISTD) {
	print "   directory $_[0] is created as UID=$<$info\n";
    }
    else {
	print "   directory $_[0] is created as USER=$ENV{'USERNAME'}\n";
    }
}


sub SetGidBit
{
    local($file) = @_;
    local($mode);

    return if $OS_TYPE eq 'BSD44';
    return if $CPU_TYPE_MANUFACTURER_OS =~ /netbsd|bsdi|freebsd|openbsd/;

    $mode = (stat($file))[2];
    $mode = $mode | 02000;
    chmod $mode, $file;
}




# remove $to if -f $to on UNIX
# but error if -f $to on MS-DOS
sub Rename
{
    local($from, $to) = @_;

    unlink $to if -f $to;

    #     |  this space is important for 
    #     V  fix_syscall.pl of NT version
    rename ($from, $to);
}


#################################################################
package dumpvar;

sub Warn { &main'Warn(@_);} #';

sub main::Dumpvar 
{
    ($package, @vars) = @_;
    my ($buf);

    $package = 'Config';

    if ($] =~ /5\.\d\d\d/) { 
	*stab = *{"${package}::"}; # SYNTAX ERROR? but this {} is required;
    }
    else {
	(*stab) = eval("*_$package");
    }

    while (($key, $val) = each(%stab)) {
	{
	    # $_ form
	    next if $key =~ /^_/;

	    # XXX workaround, quick hack
	    # XXX makefml install may fail to run on 5.6.x or 5.7.x 
	    # thanks: Yu-ji Hosokawa <yu-ji@hoso.net>
	    # thanks: Tomohiro Yamauchi <handy@nid.co.jp>
	    next if $key =~ /^EXPORT/;
	    next if $key =~ /^Config/;
	    next if $key =~ /^ISA/;

	    next if @vars && !grep($key eq $_,@vars);
	    local(*entry) = $val;

	    if (defined $entry) {
		$buf .= "\$$key = '$entry';\n";
	    }

	    if (@entry) {
		$buf .= "\@$key = (\n";
		foreach $num ($[ .. $#entry) {
		    $buf .= "\t'$entry[$num]',\n";
		}
		$buf .= ");\n";
	    }

	    if ((($] !~ /5\.\d\d\d/) && 
		 $key ne "_$package" && $key ne "_DB" && %entry
		 )
		||
		(($] =~ /5\.\d\d\d/) && 
		 $key ne "$package::" && $key ne "DB::" && 
		 %entry && 
		 ($dumpPackages || $key !~ /::$/)
		 && ($key !~ /^_</ || $dumpDBFiles)
		 && !($package eq "dumpvar" && $key eq "stab")
		 )
		) {

		$buf .= "\%$key = (\n";
		foreach $key (sort keys(%entry)) {
		    $buf .= "\t '$key', '$entry{$key}', \n";
		}
		$buf .= ");\n";
	    }
	}
    }

    return $buf;
}

# here is in "package dumpvar";


package ml;

$FH = "FLOCKDIR000";

sub ml'Log       { &main'Log(@_);}
sub main'FLock   { &ml'FLock(@_);}
sub main'FUnLock { &ml'FUnLock(@_);}
sub Warn { &main'Warn(@_);} #';

sub SetFlockParam
{
    # flock(2)
    $LOCK_SH                       = 1;
    $LOCK_EX                       = 2;
    $LOCK_NB                       = 4;
    $LOCK_UN                       = 8;
}


###
### from libkern.pl
###

### %FLockP and %FLockFile; 

# lock algorithm using flock system call
# if lock does not succeed,  fml process should exit.
sub FLock
{
    local($ml, $mldir) = @_;
    local($lockf, $unistd);

    $FH = $FH || "FLOCKDIR000";
    $unistd = $main'UNISTD; #';

    # /var/spool/ml/etc/ is an exception.
    $lockdir  = "$mldir/$ml/";
    $lockdir .= $SPOOL_DIR{$ml} || ($ml eq 'etc' ? '.' : 'spool');
    $DIR      = $DIR || "$main::ML_DIR/$ml";

    # why $ml/$ml -> $ml conversion? (may be historical reason)
    # if (!-d $lockdir) { $lockdir  =~ s#$ml/$ml#$ml#;}

    $lockf = $main'UNISTD ? $lockdir : ">> $DIR/lockfile"; #';
    $lockf = ">> ${DIR}/$main::__FlockFile" if $main::__FlockFile;

    &SetFlockParam;

    # unique file handle in this name space.
    ++$FH;
    
    open($FH, $lockf) || do {
	&Log("ERROR: Flock cannot open $lockf");
	return 0;
    };

    print STDERR "flock($FH, $LOCK_EX) for $lockdir;\n" if $debug_lock;
    eval('flock($FH, $LOCK_EX);');
    &main'Warn($@) if $@; #';

    $FLockP{$ml}   = 1;
    $LockFile{$ml} = $FH;
}


sub FUnLock 
{
    local($ml) = @_;

    &SetFlockParam;

    # another handle name $UFH to unlock
    # since $FH is unique global variable.
    $UFH = $LockFile{$ml};

    close($UFH);
    eval('flock($UFH, $LOCK_UN);');
    &main'Warn($@) if $@; #';
}


package v7;

sub Log        { print STDERR join("\t", @_), "\n";}
sub WarnE      { print STDERR join("\t", @_), "\n";}
sub WholeMail  { print STDERR join("\t", @_), "\n";}
sub SetEvent   { print STDERR join("\t", @_), "\n";}
sub Sendmail   { print STDERR join("\t", @_), "\n";}

# XXX 3.0B-TODO
sub FixPath
{
    local($ml, $mldir) = @_;
    my ($cwd);

    # global $DIR ;
    if ($UNISTD) {
	chop($cwd = `pwd`); # ATTENTION! ONLY ON UNIX
    }
    else {
	chop($cwd = `cd`);
    }
    chdir $DIR;

    # variable fixes
    local($s);
    for (SPOOL_DIR,TMP_DIR,VAR_DIR,VARLOG_DIR,VARRUN_DIR,VARDB_DIR) {
	$s .= "\$$_ = &main'Value('$_');\n"; #';
	$s .= "\$$_ =~ s\#\\\\\#/\#g;\n";
	$s .= "-d \$$_ || &Mkdir(\$$_); \$$_ =~ s#$DIR/##g;\n";
	$s .= "\$FP_$_ = \"$DIR/\$$_\";\n"; # FullPath-ed (FP)
    }
    eval($s) || &Log("FAIL EVAL \$SPOOL_DIR ...");
    &main'Warn($@) if $@; #';

    # FP-nize
    if ($LOCK_FILE !~ /$DIR/) {
	$LOCK_FILE = "$DIR/$LOCK_FILE";
	$LOCK_FILE =~ s#//#/#g;
	$LOCK_FILE =~ s#\\#/#g;
    }

    chdir $cwd;
}

sub main'V7Lock #';
{
    local($ml, $mldir) = @_;

    undef %INC;
    require 'libkern.pl';
    require 'liblock.pl';

    $EXEC_DIR = $main'EXEC_DIR;
    $ML_DIR   = $main'ML_DIR;
    $DIR      = "$mldir/$ml";

    &main'GetConfigPH($ml); #';

    $LOCK_FILE   = &main'Value('LOCK_FILE'); #';
    $MAX_TIMEOUT = &main'Value('MAX_TIMEOUT'); #';
    &FixPath($ml, $mldir);

    if ($debug) {
	print STDERR "\n";
	print STDERR "LOCK_FILE     $LOCK_FILE\n";
	print STDERR "FP_VARRUN_DIR $FP_VARRUN_DIR\n";
	print STDERR "FP_VARLOG_DIR $FP_VARLOG_DIR\n";
    }

    &GetTime(time);

    &V7Lock;

    $FLockP{$ml}   = 0;
    $LockFile{$ml} = $LockFile;

    # sigalarm ; clean up
    $main'CleanUpLockFiles = 1;
}

sub CleanUpLockFiles
{
    local($max);

    for (keys %LockFile) { 
	$max = 10;		# for each lockfile
	$_ = $LockFile{$_};

	next unless $_;

	while (-f $_ && $max-- > 0) {
	    unlink $_;
	    sleep 1;
	    
	    if (-f $_) {
		print STDERR "Try to unlink $_\n";
	    }
	    else {
		print STDERR "unlink $_\n";
	    }
	}

	if ($max <= 0) {
	    print STDERR "ERROR: cannot unlink $_, give up!\n";
	    print STDERR "       Please remove $_ by hand, please\n";
	}
    }
}

sub main'V7UnLock #';
{
    local($ml) = @_;

    if ($main::debug) {
	my (@c) = caller;
	&Log("V7UnLock: $c[1] $c[2]");
    }

    $LockFile = $LockFile{$ml};

    if ($LockFile) {
	require 'liblock.pl';
	&V7Unlock;
    }
    else {
	print STDERR "ERROR: undefined LockFile (unlink style lock, OK?)\n";
    }
}


package main;


sub TrySmtpConnect
{
    $TSCResult{$STRUCT_SOCKADDR} = &DoTrySmtpConnect(@_);
}    


sub DoTrySmtpConnect
{
    local($host) = @_;
    local($result, $eval, $perl5_socket_ok, $r);

    print STDERR "--\$TrySmtpConnect = $TrySmtpConnect\n" if $debug;

    # only the first time
    # &SetSockAddr unless $TrySmtpConnect++;

    # check the previous check host, 
    # cache is effective if probed to the same host.
    # should reset %TSCResult (sockaddr check result) for each host to check.
    if ($TSCHost ne $host) {
	$TSCHost = $host;
	undef %TSCResult;
    }
    elsif ($TSCResult{$STRUCT_SOCKADDR}) {
	return $TSCResult{$STRUCT_SOCKADDR};
    }

    ### PERL 5  
    if (0 && $] =~ /^5\./) { 
	eval("use Socket;");
	$perl5_socket_ok = 1 if ($@ eq '');
    }
	
    if ($perl5_socket_ok) {
	; # perl 5 Socket.pm must be O.K.;
    }
    elsif ($OS_TYPE eq 'SOLARIS2' || 
	$CPU_TYPE_MANUFACTURER_OS =~ /solaris2|sysv4/i) {
	$eval  = "sub AF_INET {2;}; sub PF_INET { 2;};";
	$eval .= "sub SOCK_STREAM {2;}; sub SOCK_DGRAM  {1;};";
	eval $eval;
	&Debug("TrySmtpConnect: $@") if $@;
    }
    else { # 4.4BSD (and 4.x BSD's)
	$eval  = "sub AF_INET {2;}; sub PF_INET { 2;};";
	$eval .= "sub SOCK_STREAM {1;}; sub SOCK_DGRAM  {2;};";
	eval $eval;
	&Debug("TrySmtpConnect: $@") if $@;
    }

    local($pat)    = $STRUCT_SOCKADDR || 'S n a4 x8';
    local($addrs)  = (gethostbyname($host || 'localhost'))[4];
    local($proto)  = (getprotobyname('tcp'))[2];
    local($port)   = $PORT || (getservbyname('smtp', 'tcp'))[2];
    $port          = 25 unless defined($port); # default port

    # Check the possibilities of Errors
    return ("Cannot resolve the IP address[$host]") unless $addrs;
    return ("Cannot resolve proto")                 unless $proto;

    # O.K. pack parameters to a struct;
    local($target) = pack($pat, &AF_INET, $port, $addrs);

    # IPC open
    if (socket(S, &PF_INET, &SOCK_STREAM, $proto)) { 
	$result = "socket ok";
    } 
    else { 
	$VERBOSE_STR = 
	    sprintf("socket(S, %s, %s, %s)", &PF_INET, &SOCK_STREAM, $proto);
	return ("Smtp::socket->ERROR[$!]");
    }
    
    if (connect(S, $target)) { 
	sysread(S, $result, 4096); # anyway get it.
	$result = "connect ok";
     } 
    else { 
	$VERBOSE_STR = sprintf("connect(S, %s, %s, %s, %s)\n",
			       $pat, &AF_INET, $port, $addrs);
	return ("Smtp::connect($host)->ERROR[$!]");
    }

    close(S);

    $result; # success;
}

sub FYI
{
    local($r, $m);

    &SetSockAddr;
    $r = &TrySmtpConnect('localhost');

    if ($r eq 'connect ok') {
	# $m .= "OK...sendmail RUN on this machine.\n";
    }
    elsif ($r =~ /Smtp\:\:socket/) {
	$m .= "Hmm... perl's socket() fails on this machine.\n";
	$m .= "($r)\n\n" if $r;

	$m .= "But don't worry!\n";
	$m .= "fml would send mails by 'exec sendmail' NOT IPC.\n";
    }
    elsif ($r =~ /Smtp\:\:connect.*connection refused/) {
	$m .= "Hmm... fml cannot connect sendmail on this machine.\n";
	$m .= "($r)\n\n" if $r;

	$m .= "But don't worry!\n";
	$m .= "fml would send mails by 'exec sendmail' NOT IPC.\n";

	$m .= 
	    "(\$HOST in config.ph should be a machine where sendmail runs)\n";
	$m .= &MX;
    }
    else {
	$m .= "Hmm... fml cannot connect sendmail on this machine.\n";
	$m .= "($r)\n\n" if $r;

	$m .= "But don't worry!\n";
	$m .= "fml would send mails by 'exec sendmail' NOT IPC.\n";
    }

    if ($m || $verbose) {
	$r = "$r\n $VERBOSE_STR" if $verbose;
	$m =~ s/\n/\n   /g;
	$r =~ s/\n/\n   /g;

	print STDERR "\n  For Your Information:\n   $m\n";
    }
}


sub MX
{
    local($mx, $m);
    $mx = `nslookup -q=mx "$DOMAIN."`;
    $m .= "\tsendmail may run in your $DOMAIN:\n";
    for (split(/\n/, $mx)) {
	/mail exchanger\s*=\s*(\S+)/ && ($m .= "\t$1\n");
    }
    $m;
}


sub SetSockAddr
{
    local($ostype) = @_;
    local($r);

    print STDERR "---SetSockAddr\n" if $debug;

    if ($CorrectStructSockAddr) { return $CorrectStructSockAddr;}

    print STDERR "---SetSockAddr => ProbeSockAddr\n" if $debug;

    $r = &ProbeSockAddr;

    return if ($r eq 'connect ok');

    if ($ostype =~ /netbsd|bsdi/) {
	$STRUCT_SOCKADDR = "n n a4 x8";
    }
    else {
	$STRUCT_SOCKADDR = "S n a4 x8";
    }
}


sub ProbeSockAddr
{
    local($r);
    local($tab) = "\#probe sockaddr: ";
    
    print STDERR "---ProbeSockAddr\n" if $debug;

    if ($CorrectStructSockAddr) { return $CorrectStructSockAddr;}

    print STDERR "---ProbeSockAddr scan ...\n" if $debug;

    for ($STRUCT_SOCKADDR, "n n a4 x8", "S n a4 x8", "x C n C4 x8") {
	undef $STRUCT_SOCKADDR;
	next unless $_;
	$STRUCT_SOCKADDR = $_;

	$r = &TrySmtpConnect("localhost");

	if ($r eq 'connect ok') { 
	    $CorrectStructSockAddr = $STRUCT_SOCKADDR;;
	    print STDERR "${tab}OK  '$_'\n" if $verbose;
	    return $r;
	}
	else {
	    if ($verbose) {
		print STDERR "${tab}NOT '$_' ($r $VERBOSE_STR)\n";
	    }
	}
    }
}


sub ProbePerlVersion
{
    local($jperl4);

    print STDERR "ProbePerlVersion: $^X -v \n" if $debug;
    open(PERL, "$^X -v |");
    while (<PERL>) {
	$UnderJPerl = 1 if /jperl/;
    }
    close(PERL);

    # if jperl 4, always bad.
    if ($UnderJPerl && ($] =~ /Revision.*4\.0/)) { $jperl4 = 1;}

    # if jperl 5, check jperl or perl ?
    # try to check regexp working
    if ("\xa4\xa2" =~ m/^.$/) {
	$JPerlMode = "euc";
    }
    elsif ("\x80\xa0" =~ m/^.$/) {
	$JPerlMode = "sjis";
    }
    else { # must be usual perl
	$JPerlMode = "unknown"; # jperl4 matches here?
	$UnderJPerl = 0;
    }

    # if jperl 4, always jperl is jperl.
    $UnderJPerl = 1 if $jperl4;
}


sub PermCheck
{
    local($path) = @_;
    local($x, $dir, @p, $hit, $buf);
    local($mode, $uid, $gid, $owner, $group);

    @p = split(/\//, $path);

    undef $dir;
    $dir = "/";
    for $x (@p) {
	$dir .= $dir ? "/$x" : $x;
	$dir =~ s#^//+#/#;
	($mode, $uid, $gid) = (stat($dir))[2,4,5];

	($owner) = (getpwuid($uid))[0];
	($group) = (getgrgid($gid))[0];

	if ($mode & 0002) { 
	    $buf .= sprintf("%-20s   %s\n", "$dir", "world writable");
	    $hit++;
	}

	if ($mode & 0020) { 
	    $buf .= sprintf("%-20s   %s\n", "$dir", "group($group) writable");
	    $hit++;
	}

	if ($debug && ($mode & 0200)) { 
	    $buf .= sprintf("%-20s   %s\n", "$dir", "owner($owner) writable");
	    $hit++;
	}
    }

    if ($hit) {
	print "*** WARNING ***\n";
	print "[$path] has invalid path directory(ies).\n";
	print "\n$buf\n";
	print "Latest MTA's check group writable or not in them\n";
	print "If you permit this permission for some reason,\n";
	print "you must need additonal settings in e.g. /etc/sendmail.cf.\n";
	print "Please read manuals of your MTA for more details.\n";
    }
}


########################################################################
package Menu;

sub Menu'Log  { &main'Log(@_);}
sub Menu'Warn { &main'Warn(@_);}
sub Menu'Die  { &main'Die(@_);}

sub GetManifest
{
    local(*MANIFEST, $mf) = @_;
    local($key, $str);

    if (open(MF, $mf)) {
	while (<MF>) {
	    if (/^(\S+):\s*(.*)/) { # VARIABLE NAME: DEFAULT VALUE
		$key = $1;
		$str = $2;
		$MANIFEST{$key} = $str;
		print STDERR "\$MANIFEST{$key} = $str;\n" if $debug;
	    }
	}
	close(MF);
    }
    else {
	&Log("GetManifest: cannot open $mf");
    }
}


sub InitMenu
{
    local($cur_variable);

    (*config, *MENU, *FP, *QUERY, *NAME, *MAP, *BIND, *CONFIG, *HOOK) = @_;

    $EXEC_DIR = $main'EXEC_DIR; #';
    &GetManifest(*MANIFEST, "$EXEC_DIR/cf/MANIFEST");

    open(F, $MENU) || &Die($!);
    while (<F>) {
	next if /^\#/;
	
	if (/\$MANIFEST/) {
	    print STDERR "$_ => " if $debug;
	    s/\$MANIFEST\{[\'"](\S+)[\'"]\}/sprintf("%s", $MANIFEST{$1})/e;
	    print STDERR "<$_>(MANIFEST)\n" if $debug;
	}
	
	if (/^==/) {
	    &Reset;
	    next;
	}
	elsif (/^\/(.*)/) {
	    $hier  = "/";
	    $hier .= join("/", split(/\//, $1));
	    $main::VALID_HIER{$hier} = 1;
	    next;
	}
	elsif (/^=menu/) {
	    &Reset;
	    $menu_p = 1;
	    next;
	}
	elsif (/^=name/) {
	    &Reset;
	    $name_p = 1;
	    next;
	}
	elsif (/^=map/) {
	    &Reset;
	    $map_p = 1;
	    next;
	}
	elsif (/^=hook/) {
	    &Reset;
	    $hook_p = 1;
	    next;
	}
	elsif (/^=query_pat/) {
	    &Reset;
	    $query_pat_p = 1;
	    next;
	}
	elsif (/^=query/) {
	    &Reset;
	    $query_p = 1;
	    next;
	}
	elsif (/^=config/) {
	    &Reset;
	    $config_p = 1;
	    next;
	}



	if ($menu_p) {
	    # this Name Space is Global
	    $MenuTemplate{$hier} .= $_;
	}
	elsif ($query_p) {
	    $QUERY{$hier} .= $_;
            push(@YES_OR_NO, $cur_variable)
                 if $cur_variable && /y-or-n/ && 
                 (! grep(/$cur_variable/, @YES_OR_NO));
	}
	elsif ($config_p) {
	    s/\s//g;
	    $CONFIG{$hier} .= $_ if $_ !~ /^\s*$/;
            $cur_variable = $_ if $_ !~ /^\s*$/;

	    ## WHEN $cur_variable is not in $DIR/cf, set default ##
	    ## Hmm... I should do it? NO! explict $NULL can be overwritten ##
            ## if ((!$config{$cur_variable}) && $MANIFEST{$cur_variable}) {
	    ##    $config{$cur_variable} = $MANIFEST{$cur_variable};
	    ## }
	}
	elsif ($name_p) {
	    next if /^\s*$/;
	    $_ =~ s/^\s+//;
	    s/\n$//g;
	    $NAME{$hier} .= $_;
	}
	elsif ($map_p) {
	    $_ =~ s/^\s+//;
	    $MAP{$hier} .= $_;
	    my($x, $y) = split(/\s+/, $_, 2);
	    $main::MAP_RAW_VALUE{$hier, $x} = $y; # cache for cgi use  
	}
	elsif ($hook_p) {
	    $HOOK{$hier} .= $_;
	}
	elsif ($query_pat_p) {
	    $_ =~ s/^\s+//;
	    $QUERY_PAT{$hier} .= $_;
	}
    }

    close(F);

    for $menu (keys %MenuTemplate){
	&EvalMenu($menu, *config, *BIND, *MENU, *COUNT, *MAP, *query);
    }
}

sub main'EvalMenu { &EvalMenu(@_);} #';
sub EvalMenu
{
    local($menu, *config, *BIND, *MENU, *COUNT, *MAP, *query) = @_;
    local($buf);

    # global
    $Count = 0;

    ### YES/NO MAP
    my ($key);
    for $key (REMOTE_ADMINISTRATION, 
	 PASS_ALL_FIELDS_IN_HEADER,
	 @YES_OR_NO
	 ) {
	# $DIR/cf has this variable entry
	if ($CFdefined{$key}) {
	    $SUMMARY{$key} = $config{$key} ? "YES" : "NO";
	}
	# $DIR/cf has not this variable entry, use cf/MANIFEST default value
	else {
	    # must be not set by anybody.
	    if ($config{$key} eq '') {
		$SUMMARY{$key} = $MANIFEST{$key} ? "YES" : "NO";
	    }
	    # must be set by 'makefml config'
	    else {
		$SUMMARY{$key} = $config{$key} ? "YES" : "NO";
	    }
	}
    }

    ### others
    $SUMMARY{'SPOOLING'} = $config{'NOT_USE_SPOOL'} ? "NO" : "YES";

    $SUMMARY{'CONTROL_ADDRESS'} = 
	$config{'CONTROL_ADDRESS'} || "*** Command Unavailable ***";

    $SUMMARY{'PASS_RECEIVED_THROUGH'} =
	($config{'SKIP_FIELDS'} =~ /Received/i) ? "NO" : "YES";

    if ($config{'REWRITE_TO'} == 0) {
	$SUMMARY{'REWRITE_TO'} = "To: is original (pass through)";
    }
    elsif ($config{'REWRITE_TO'} == 1) {
	$SUMMARY{'REWRITE_TO'} = "To: MAIL_LIST, others";
    }
    elsif ($config{'REWRITE_TO'} == 2) {
	$SUMMARY{'REWRITE_TO'} = "To: MAIL_LIST";
    }

    local($xlabel);
    for (split(/\n/, $MenuTemplate{$menu})) {
	# substitute
	if (/_i_\s+(\S+)/) {
	    s/(_i_\s+\S+)/&Bind(*BIND, $1, $menu)/e;
	}
	s/^\s/   /;
	$buf .= "$_\n";
    }

    # menu evaluator
    eval("\$buf = \"$buf\";");
    &main'Warn($@) if $@; #';

    # IF type == number, should ignore this conversion.
    if ($query{'type'} ne 'number') {
	# $buf =~ s/(\s)1\s*\n/$1USE\n/g;
	# $buf =~ s/(\s)0\s*\n/$1NOT USE\n/g;
	$buf =~ s/(\s)1(\s*\n)/${1}YES${2}/g;
	$buf =~ s/(\s)0(\s*\n)/${1}NO${2}/g;
    }

    $buf =~ s/\$DOMAINNAME/$config{'DOMAINNAME'}/g;
    $buf =~ s/\$FQDN/$config{'FQDN'}/g;

    $MENU{$menu}  = $buf;
    $COUNT{$menu} = $Count;

    for (split(/\n/, $MAP{$menu})) {
	if (/^\s*(\S+)\s*(.*)\s*$/) {
	    $MAP{$menu, $1} = $2;
	    $MAP{$menu, $1} =~ s/\$config\{\'_ML_\'\}/$config{'_ML_'}/g;
	}
    }
}


sub FixDefault
{
    local(*query, *config, $top_level) = @_;
    local(@x, $x);

    print STDERR "change default: ($top_level)\n" if $debug;

    if ($query{"type"} eq "y-or-n" || 
	$query{"type"} eq "reverse-y-or-n") {
	@x = split(/\//, $top_level);
	$x = $x[$#x];
	$x = $Menu'CONFIG{$top_level} ? $Menu'CONFIG{$top_level} : $x;

	print STDERR "   $x => $config{$x} ? 'y' : 'n'\n" if $debug; 

	if ($query{"type"} eq "y-or-n") {
	    $query{'default'} = $config{$x} ? 'y' : 'n';
	}
	else {
	    $query{'default'} = $config{$x} ? 'n' : 'y';
	}
    }
    else {
	print STDERR "   no operation (no conversion)\n" if $debug;
    }
}


sub GenQuery
{
    local(*query, $s, $level) = @_;
    local($type, $pat);

    %query = ();
    print STDERR "GenQuery::(top_level=$level)\ns=$s]\n" if $main'debug; #';

    for (split(/\n/, $s)) {
	if (/(\S+):\s+(.*)\s*$/) {
	    $query{$1} = $2;
	}
    }
    
    # "type", "menu", "query", "pat", "default"
    $type = $query{"type"};

    if ($type eq "y-or-n" || $type eq "reverse-y-or-n") {
	$query{"menu"}    = $query{"menu"}    || "Use this option?";
	$query{"query"}   = $query{"query"}   || "y/n";
	$query{"pat"}     = $query{"pat"}     || "y|n";
	$query{"default"} = $query{"default"} || "n";
    }
    elsif ($type eq "select" || $type eq "select-direct-map") {
	$max = $COUNT{$level} - 1;
	for (0 .. $max) { $pat .= $pat ne "" ? "|$_" : $_;}

	$max  = $max == 1 ?  "0-1" : "0-$max";

	$query{"menu"}    = $query{"menu"}    || "Which section?";
	$query{"query"}   = $query{"query"}   || $max;
	$query{"pat"}     = $query{"pat"}     || $pat;
	$query{"default"} = $query{"default"} || 0;
    }
    elsif ($type eq "string") {
	$query{"menu"}    = $query{"menu"}    || "Please input a string";
	$query{"query"}   = $query{"query"}   || '\S+';
	$query{"pat"}     = $query{"pat"}     || '\S+';
	$query{"default"} = $query{"default"} || $NULL;
    }
    elsif ($type eq "number") {
	$query{"menu"}    = $query{"menu"}    || "Please input a number";
	$query{"query"}   = $query{"query"}   || 'e.g. 10 or 10K or 10M';
	$query{"pat"}     = $query{"pat"}     || '\d+|\d+K|\d+M';
	$query{"default"} = $query{"default"} || 0;
    }
    else {
	&Die("GenQuery: unknown \$type=[$type]\n");
    }
}


sub Reset
{
    undef $menu_p;
    undef $query_p;
    undef $query_pat_p;
    undef $name_p;
    undef $map_p;
    undef $config_p;
    undef $hook_p;
}


sub Bind
{
    local(*bind, $s, $menu) = @_;
    local($index, $label, $html_ptr, $xl, $ptr, $v);
    local($le_label); # message language extension

    if ($s =~ /(_i_\s+)(\S+)/) {
	$index = $1;
	$xl = $label = $2;

	$index =~ s/_i_/sprintf("%-3s", $Count)/ge;
	$bind{$menu, $Count} = $label;

	# message language extension (/a/b/c -> Japanese)
	$le_label = &main'LangExtConv("$menu/$xl"); #';

	# return value is rewritten .
	$label = $NAME{"/$label"} || $label;
    }

    if ($Count == 0) {
	$ptr = $menu;
	$ptr =~ s#/[^/]+$##;
	$ptr = "/". $ptr;
	$ptr =~ s#//#/#g;
	$html_ptr = "<A HREF=${MakefmlCGI}&PTR=$ptr>";
    }
    # elsif ($v = $MAP{$menu, $Count}) {  # SHOW RAW VALUE IN HTML
    # elsif ($v = $MAP{$menu, $Count}) {  # SHOW POINTER IN HTML
    # elsif (defined ($v = $MAP{$menu, $Count})){ # SHOW POINTER IN HTML
    elsif (($v = $MAP{$menu, $Count}) ne ''){ # SHOW POINTER IN HTML
	local($vn);
	$ptr = $menu;
	$ptr =~ s#//#/#g;
	$vn = $CONFIG{$menu} || 'unknown';
	$vn = "VARIABLE=$vn";
	$html_ptr = "<A HREF=${MakefmlCGI}&PTR=$ptr&${vn}&VALUE=$Count>";
    }
    else {
	$ptr = "$menu/$xl";
	$ptr =~ s#//#/#g;

	# select the value (not select menu)
	$html_ptr = "<A HREF=${MakefmlCGI}&PTR=$ptr>";
    }

    $Count++;

    if ($main'HtmlConfigMode) { #';
	"${html_ptr}$index". ($le_label || $label) . "</A>";
    }
    elsif ($ENV{'MAKEFML_LANG'}) {
	local($lang) = $ENV{'MAKEFML_LANG'};
	require 'jcode.pl';
        &jcode'convert(*le_label, $lang); #';

	$le_label ? "${index}${le_label}" : "${index}${label}";
    }
    else {
	"$index$label";
    }
}


###### NT specific #####
package main;

sub MenuInputLoop
{
    local($cmd, $menu);

    $menu = qq#;
    Please input makefml\'s command and the arguments;
    For example, for the ML \"elena\"; 
    \tnewml elena  (makefml newml elena);
    \tconfig elena (makefml config elena);
    ;#;
    $menu =~ s/;//g;

    while (1) {
	print "\n"; print "-" x 60; print "\n";
	print $menu;

	$cmd = &Query("Input", "command arguments", 
		      '.*', "help");

	$cmd =~ s/^\s*(makefml|makefml\.\S+)\s//;

	system "$^X $0 $cmd" if $Env eq 'CUI';

	$cmd = &Query("Do you continue?", "y/n", "y|n", "y");
	if ($cmd eq 'n') { last;}
    }
}


##### WWW/CGI Interfaces #####
package main;

# set up cgi for admin (full access for fml system)
#    $EXEC_DIR/www/cgi-bin/admin/.htaccess
#    $CGI_AUTHDB_DIR/admin/htpasswd
sub SetUpCGIadmin
{
    my ($mode) = @_;
    local($cmd);

    &ResetVariables;

    $SSL_REQUIRE_SSL = 'SSLRequireSSL';

    &MkDirHier("$EXEC_DIR/www/cgi-bin/admin");
    &MkDirHier("$REAL_CGI_PATH/admin");

    &Conv($NULL, DestDir("$EXEC_DIR/www/etc/dot_htaccess.admin"),
	  DestDir("$EXEC_DIR/www/cgi-bin/admin/.htaccess"));

    &Conv($NULL, DestDir("$EXEC_DIR/www/etc/dot_htaccess.admin"),
	  DestDir("$REAL_CGI_PATH/admin/.htaccess"));

    # first time!
    $htpasswd = DestDir("$CGI_AUTHDB_DIR/admin/htpasswd");
    if (! -f $htpasswd) {
	# we enforce valid-user in .htaccess, so empty htpasswd is invalid :)
        &SetPublicUmask;
	&MkDirHier("$CGI_AUTHDB_DIR/admin");
	&Touch($htpasswd);
	chmod 0644, $htpasswd;
    }

    # make cgi-bin/admin/
    print STDERR "\n";
    print STDERR "Setup CGI examples ";


    $SilentMode = 1;
    &do_setup_admin_cgi_scripts($NULL);
    print ".";
    $SilentMode = 0;
    for (<www/examples/*/*>) {
	print ".";
	&Conv($NULL, $_, DestDir("$EXEC_DIR/$_"));
    }
    print "\n";
    &SaveCGIConf;

    print STDERR "\n";
}


sub LoadCGIConf
{
    if (-f $CGI_CONFIG) {
        eval("require \"$CGI_CONFIG\";");
	&Log($@) if $@;
    }
}


sub SaveCGIConf
{
    local($cf, $new);

    $cf  = $CGI_CONFIG || "$CONFIG_DIR/cgi.conf";
    $cf = DestDir($cf);
    $new = $cf.".new$$";

    if (open(CF, "> $new")) {
	select(CF); $| = 1; select(STDOUT);

	# log date 
	print CF "\# $MailDate(configured by $0)\n\n";
	print CF "\$REAL_CGI_PATH   = \"$REAL_CGI_PATH\";\n";
	print CF "\$CGI_AUTHDB_DIR  = \"$CGI_AUTHDB_DIR\";\n";
	print CF "\$SSL_REQUIRE_SSL = \"$SSL_REQUIRE_SSL\";\n";
	print CF "\n# MTA configuration\n";
	print CF "\$MTA                 = \"$MTA\";\n";
	print CF "\$HOW_TO_UPDATE_ALIAS = \"$HOW_TO_UPDATE_ALIAS\";\n";
	print CF "\n1;\n";
	close(CF);
    }
    else {
	&Log("cannot open $new");
    }

    # if valid perl script, rename($new, $cf);
    if (&ValidatePerlScriptP($new)) {
	if (rename($new, $cf)) {
	    print STDERR "      CGI configuration is saved in $cf\n";
	}
	else {
	    &Log("ERROR: cannot rename($new, $cf)");
	}
    }
}


sub do_admin_cgi_config
{
    local($ml) = @_;
    local($cf);

    &ResetVariables;

    $cf  = $CGI_CONFIG || "$CONFIG_DIR/cgi.conf";
    $new = $cf.".tmp$$";

    # import 
    delete $INC{$cf};
    package cgi;
    eval require $main::cf;
    print STDERR $@ if $@;
    $main::REAL_CGI_PATH   = $REAL_CGI_PATH;
    $main::CGI_AUTHDB_DIR  = $CGI_AUTHDB_DIR;
    $main::SSL_REQUIRE_SSL = $SSL_REQUIRE_SSL;

    # MTA
    $main::MTA                 = $MTA;
    $main::HOW_TO_UPDATE_ALIAS = $HOW_TO_UPDATE_ALIAS; 
    package main;
    &Die($@) if $@;

    &InitTTY;
    $MenuNarrowLineSkip = 1;

    # "clear" not exist on NT4
    $clear_prog = $UNISTD ? &__SearchPath('clear') : "cls";

    # overwrite SSL configuratino.
    if ($ml){
	my ($s) = &Grep('^SSLRequireSSL', 
			"$REAL_CGI_PATH/ml-admin/$ml/.htaccess");
	$s =~ s/\s*$//;
	$SSL_REQUIRE_SSL = $s;
    }

    local(%query) = (
		     'SSL_REQUIRE_SSL' => $SSL_REQUIRE_SSL,
		     'REAL_CGI_PATH'   => $REAL_CGI_PATH,
		     'CGI_AUTHDB_DIR'  => $CGI_AUTHDB_DIR,

		     'MTA'                 => $MTA,
		     'HOW_TO_UPDATE_ALIAS' => $HOW_TO_UPDATE_ALIAS, 
		     );
    $query{'SSL_REQUIRE_SSL'} = $SSL_REQUIRE_SSL eq 'SSLRequireSSL' ? "YES" : "NO";

    local(%original_query) = %query;

    local(%variable);

    while (1) {
	if ($clear_prog) {
	    if (! $debug) { &__system($clear_prog);}
	    print "   ".("*" x 60); print "\n";
	    print "\n";
	    print "\t<<< makefml --- FML CGI Configuration Interface --- >>>\n";
	    print "\n";
	}
	else {
	    print "   ".("*" x 60); print "\n";
	}

	if ($ml) {
	    %variable = (
			 0 => "END",
			 1 => "USE_MOD_SSL         $query{'SSL_REQUIRE_SSL'}",
			 2 => "CHANGE PASSWORD",
			 3 => "REMAKE CGI SCRIPTS",
			 );
	    %varname = (
			1 => "SSL_REQUIRE_SSL",
			2 => "CHANGE PASSWORD",
			3 => "REMAKE CGI SCRIPTS",
			);
	}
	else {
	    %variable = (
			 0 => "END",
			 1 => "USE_MOD_SSL         $query{'SSL_REQUIRE_SSL'}",
			 2 => "REAL_CGI_PATH       $query{'REAL_CGI_PATH'}",
			 3 => "CGI_AUTHDB_DIR      $query{'CGI_AUTHDB_DIR'}",
			 4 => "CHANGE PASSWORD",
			 5 => "REMAKE CGI SCRIPTS",
			 6 => "MTA                 $query{'MTA'}",     
			 7 => "HOW TO UPDATE ALIAS $query{'HOW_TO_UPDATE_ALIAS'}",
			 );
	    %varname = (
			1 => "SSL_REQUIRE_SSL",
			2 => "REAL_CGI_PATH",
			3 => "CGI_AUTHDB_DIR",
			4 => "CHANGE PASSWORD",
			5 => "REMAKE CGI SCRIPTS",
			6 => "MTA",
			7 => "HOW_TO_UPDATE_ALIAS",
			);
	}

	&cgi_config_show(*variable);
	if ($ml) {
	    $r = &Query("which ?", "0-3", "0|1|2|3", '0');
	}
	else {
	    $r = &Query("which ?", "0-7", "0|1|2|3|4|5|6|7", '0');
	}

	if ($r == 0) {
	    last;
	}
	else {
	    &cgi_menu_mainloop(*query, $varname{$r}, $ml);
	}

	# update config for other menu's
	$SSL_REQUIRE_SSL = $query{'SSL_REQUIRE_SSL'} eq "YES" ? 
	    'SSLRequireSSL' : $NULL;
    }

    # save config
    if (join(" ",%original_query) ne join(" ", %query)) {
	$SSL_REQUIRE_SSL = $query{'SSL_REQUIRE_SSL'} eq "YES" ? 
	    'SSLRequireSSL' : $NULL;
	$REAL_CGI_PATH   = $query{'REAL_CGI_PATH'};
	$CGI_AUTHDB_DIR  = $query{'CGI_AUTHDB_DIR'};

	$MTA                 = $query{'MTA'};
	$HOW_TO_UPDATE_ALIAS = $query{'HOW_TO_UPDATE_ALIAS'};
	&SaveCGIConf;
	print "\n";

	$r = &Query("Q: Can I recreate cgi scripts?", "y/n", "y|n", 'n');
	if ($r eq 'y') {
	    print "\n";

	    if ($ml) {
		&do_setup_mladmin_cgi_scripts($ml);
	    }
	    else {
		&do_setup_admin_cgi_scripts($NULL);
	    }
	}
	else {
	    print "\n";
	    print "FYI: If you recreate cgi scripts, please run\n";
	    if ($ml) {
		print "     $0 admin.cgi update\n";
	    }
	    else {
		print "     $0 ml-admin.cgi $ml update\n";
	    }
	    print "\n";
	}
    }
}


sub cgi_config_show
{
    local(*variable) = @_; 

    my ($k);
    for $k (sort {$a <=> $b} keys %variable) {
	printf "%-3d   %s\n", $k, $variable{$k};
    }
    print "\n";
}


sub cgi_menu_mainloop
{
    local(*query, $which, $ml) = @_;

    local (%mta) = (0 => 'END',
		    1 => 'sendmail',
		    2 => 'postfix'
		    );
    local (%alias) = (0 => 'END',
		      1 => 'newaliases',
		      2 => "postalias $ML_DIR/etc/aliases",
		      );


    # SSL ?
    if ($which eq 'SSL_REQUIRE_SSL') {
	while (1) {
	    my $default = $query{SSL_REQUIRE_SSL} ? 'y' : 'n';
	    $r = &Query("Q: DO YOU USE SSL?", "y/n", "y|n", $default);
	    if ($r eq 'y' || $r eq 'n') { 
		$query{'SSL_REQUIRE_SSL'} = $r eq 'y' ? "YES" : "NO";
		last;
	    };
	}
    }
    elsif ($which eq 'REAL_CGI_PATH' || $which eq 'CGI_AUTHDB_DIR') {
	my $r   = $query{ $which };
	my $buf = &Query("Q: $which", 'directory', '[\.\d\w\/\\\\\-]+', $r);
	$query{$which} = $buf;
    }
    elsif ($which eq "MTA") {
	&cgi_config_show(*mta);
	$r = &Query("which ?", "0-2", "0|1|2", '0');
	$query{$which} = $mta{$r} if $r > 0;
    }
    elsif ($which eq "HOW_TO_UPDATE_ALIAS") {
	&cgi_config_show(*alias);
	$r = &Query("which ?", "0-2", "0|1|2", '0');
	$query{$which} = $alias{$r} if $r > 0;
    }
    elsif ($which eq "CHANGE PASSWORD") {
	&ResetVariables;
	$prog = &__SearchPath('htpasswd');

	if (! ($prog && -x $prog)) {
	    &Error("cannot find 'htpasswd'");
	    return;
	}
	my ($dir, $pwf);

	if ($ml) {
	    $dir = "$CGI_AUTHDB_DIR/ml-admin/$ml";
	    $pwf = "$CGI_AUTHDB_DIR/ml-admin/$ml/htpasswd";
	}
	else {
	    $dir = "$CGI_AUTHDB_DIR/admin/";
	    $pwf = "$CGI_AUTHDB_DIR/admin/htpasswd";
	}

	if (! -f $pwf) {
	    &SetPublicUmask;
	    $flag = '-c';
	    &MkDirHier($dir);
	    &Touch($pwf);
	    chmod 0644, $pwf;
	}

	my $user = &Query("user", $ENV{'USER'}, '[\w\d+\-_\.]+', $ENV{'USER'});

	print STDERR "\% $prog $flag $pwf $user\n";
	if ($flag) {
	    &__system($prog, $flag, $pwf, $user);
	}
	else {
	    &__system($prog, $pwf, $user);
	}
	sleep 2;
    }
    elsif ($which eq "REMAKE CGI SCRIPTS") {
	if ($ml) {
	    &do_setup_mladmin_cgi_scripts($ml);
	}
	else {
	    &do_setup_admin_cgi_scripts($NULL);
	}
	sleep 2;
    }
}


sub ValidatePerlScriptP
{
    local($cf) = @_;

    # XXX $cf string is fixed or generated by makefml itself.
    if ($UNISTD) {
	system "$^X -c $cf >/dev/null 2>&1";
    }
    else {
	system "$^X -c $cf > nul 2>&1";
    }
    if ($?) {
	print "\n";
	&_Error("$cf is broken as perl script.");
	&Log("$cf is broken as perl script.");
    }

    $? ? 0 : 1; # $? is 0 if normal. 
}


sub InitErrorBuffer
{ 
    $HtmlWarnBuffer = $WStatus;
    $HtmlExitBuffer = $XStatus;
}


sub FixErrorBuffer
{
    local($fp) = @_;

    # When html_config works, do not show 'return value' 
    # since it is the first phase of interactive session.
    if ($fp eq 'do_html_config') {
	return;
    }

    if ($WStatus eq $HtmlWarnBuffer && $HtmlExitBuffer eq $XStatus) {
	if (!$XStatus) {
	    $XStatus = 'OK:';
	}
    }
    else {
	print $WStatus, "\n";
	print $XStatus, "\n";

	# print "  --- debug\n";
	# print "  (debug)\$HtmlWarnBuffer> $WStatus\n";
	# print "  (debug)\$HtmlExitBuffer> $XStatus\n";
	# print "  --- debug end\n";
    }
}


################################################################
#
# USE_DATABASE
#
sub InitDataBaseAccess
{
    my ($ml) = @_;

    require 'libdatabases.pl';
    require 'libkern.pl';

    $MAIL_LIST           = $ml;
    $DATABASE_METHOD     = $config_ph::DATABASE_METHOD;
    $DATABASE_DRIVER     = $config_ph::DATABASE_DRIVER;
    $SQL_SERVER_HOST     = $config_ph::SQL_SERVER_HOST;
    $SQL_SERVER_PORT     = $config_ph::SQL_SERVER_PORT;
    $SQL_SERVER_USER     = $config_ph::SQL_SERVER_USER;
    $SQL_SERVER_PASSWORD = $config_ph::SQL_SERVER_PASSWORD;
    $SQL_DATABASE_NAME   = $config_ph::SQL_DATABASE_NAME;
}


1;
