#!/usr/local/bin/perl
#
# Copyright (C) 1993-1999 Ken'ichi Fukamachi
#          All rights reserved. 
#               1993-1996 fukachan@phys.titech.ac.jp
#               1996-1999 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.
#
# $Id: makefml,v 2.31.2.16 1999/12/15 04:33:19 fukachan Exp $;


### AUTOMATICALLY REPLACED by makefml (Sun, 9 Mar 97 19:57:48 )
$CONFIG_DIR = ''; # __MAKEFML_AUTO_REPLACED_HERE__

&InitTTY;
&InitMakeFml;

# info
if ($IN_CHANNEL eq 'stdin') {
    @ARGV = split(/\s+/, <STDIN>);
}
elsif (! @ARGV) { 
    &ExecCmd("info");
    &MenuInputLoop if $opt_w;
    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 "-- Enjoy Internetworking!\n";
}

&System if $SYSTEM_ARGV || $SYSTEM_ARGV_IN || $SYSTEM_ARGV_OUT;

&FlushLog;

exit 0;


#################### LIBLARIES ####################
sub System 
{
    local($cmd);

    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 
		"* 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
{
    # 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("dhf:A:O:p:D:vwV:mi:u:UF");
    $debug   = $opt_d;
    $verbose = $opt_v;
    $MailNotify = $opt_m;
    $EnForceMode = $opt_F ? 1 : 0;

    $HOME  = $ENV{'HOME'};
    $PWD   = $ENV{'PWD'};

    $COMPAT_ARCH = $opt_A;
    $VENDOR      = $opt_V;

    $IN_CHANNEL  = $opt_i;


    ### 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)
	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);
	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;
    }

    # Anyway try once ... (may be re-installation ?)
    # Dame moto sune:-)
    if (! $CONFIG_DIR) {
	for ("$HOME/.fml", "/usr/local/fml/.fml") {
	    $CONFIG_DIR = $_ if -d $_;
	}

	# re-install case
	if ($ARGV[0] eq 'install' && $ARGV[1]) {
	    $CONFIG_DIR = "$ARGV[1]/.fml" if -d "$ARGV[1]/.fml";
	}
    }


    ### FIX VARIABLES
    $CONFIG_DIR = $opt_D || $CONFIG_DIR || "$HOME/.fml";
    $FML_CONFIG = $opt_f || "$CONFIG_DIR/system";
    $FML_POLICY = $opt_p || "$CONFIG_DIR/policy";

    # 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";

	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) {
	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);

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

# 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/local/fml',
		'ML_DIR',   '/var/spool/ml', 
		'DOMAIN',   $DOMAINNAME,
		'FQDN',     $FQDN,
		'GROUP',    '',
		'LANGUAGE', $LANGUAGE,
		'VENDOR',   '',
		'TZ',       '+0900',
		); 

    %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";
    }

    %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>',

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

		    # admin command (sub)
		    'on',     'do_on',
		    'off',    'do_off',
		    'chaddr', 'do_chaddr',
		    'matome', 'do_matome',
		    'digest', 'do_digest',
		    '40#on  ML address', 'on  <address>',
		    '40#off ML address', 'off <address>',
		    '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 address', 'add <address> as an admin to <ML>',
		    'byeadmin', 'do_byeadmin',
		    '60#byeadmin ML address', 'remove the administrator of <ML>f',

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

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

		    'fmlserv',  'do_fmlserv',
		    'listserv', 'do_fmlserv',
		    'majordomo','do_fmlserv',

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

		    # PGP
		    'pgp',	'do_pgp',
		    '90#pgp ML PGP-arguments', 'e.g. "pgp ML -ka publib_key"',

		    'delivery_mode',  'do_delivery_mode',

		    '100#fmlserv', 'set up fmlserv (listserv-like command interface)',
		    # '100#listserv','set up fmlserv (listserv-like command interface)',
		    # '100#majordomo','set up fmlserv (listserv-like command interface)',

		    # 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 address mget last:3 mp"',

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

		    # conversion
		    'conv',   'do_conv',
		    'update', 'do_update',

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

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

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


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");    
	$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");    
	    &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 = &GetString;
	    $cmd = ($cmd !~ /^\s*$/) ? $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);

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

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

	&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;

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

    $FML_CONFIG  = "$CONFIG_DIR/system";
    
    $buf = &Dumpvar('Config');
    &SaveConfig($buf) if $buf;

    print "\nThe Current Config 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 SaveConfig
{
    local($buf) = @_;

    if (-f $FML_CONFIG) { rename($FML_CONFIG, "${FML_CONFIG}.bak");}

    open(F, ">> $FML_CONFIG") || &Die("Cannot save config to $FML_CONFIG");
    select(F); $| = 1; select(STDOUT);
    print F "$buf\n";
    print F "\n1;\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) = @_;

    if (-f $FML_POLICY) { rename($FML_POLICY, "${FML_POLICY}.bak");}

    open(F, ">> $FML_POLICY") || &Die("Cannot save POLICY to $FML_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
{
    if ($TempolaryLogfile eq $MAKEFML_LOGFILE) {
	print STDERR "--- makefml log ($MAKEFML_LOGFILE) ---\n";
	&Cat($MAKEFML_LOGFILE);
	unlink $MAKEFML_LOGFILE if $TheFirstTime;
    }

    # 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);

    for $dir (@INC) {
	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(@caller) = caller;
    print STDERR "Warning:(called from @caller)\n@_\n";
    $WarnBuf = "Warning:(called from @caller)\n@_\n";
}


sub Error
{
    print STDERR "*** Error: @_\n\n";
}


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


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

    &GetTime(time);

    # 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 + $$); 
}


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

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

    # default
    $eval .= "\$USE_FLOCK = 1;\n";

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

    open(PH, "$mldir/$ml/config.ph") || 
	(&Warn("cannot open $mldir/$ml/config.ph[$!]"), return);
    while (<PH>) {
	/\$USE_FLOCK/ && ($eval .= $_);
	/\$SPOOL_DIR/ && ($eval .= $_);
    }
    close(PH);

    eval("package flockp; eval(\$main'eval); package main; #';");
    &main'Warn($@) if $@; #';

    $ml'FLockP{$ml}    = $flockp'USE_FLOCK;
    $ml'SPOOL_DIR{$ml} = $flockp'SPOOL_DIR;

    return $flockp'USE_FLOCK; #';
}

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};#'

    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"; $count++;
	
	&Lock($ml, $mldir);
	$LockList{$ml} = $mldir;
    }
    else {
	print "---Locking $mldir\n\t";

	opendir(DIRD, $mldir);
	for $dir (readdir(DIRD)) {
	    next if /^\./;
	    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";
    }
    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";
	&UnLock($ml);
    }
    else {
	print "---UnLocking\n\t";

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

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

    print "\nDone.\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+/, $_);

    &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 ?

    # 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 ($< == 0 && $uid != $<) { 
	    &WarnYourAreRoot;
	}
    }


    # Lock all when "install"
    if ($TheFirstTime || $NOT_LOCK{$fp}) {
	;
    }
    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";
	&$fp(@argv);
    }
    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 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 = &search_path('perl.exe');
    }
    else {
	$perl = &search_path('perl');
    }

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

    while (<PROG>) {
	if ($. == 1) {
	    print NEW "\#\!$perl\n" if $perl;
	    next;
	}

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

	# recreate my own;
	if ($prog =~ /makefml/ && 
	    /__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, "${prog}.new";

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


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

    # 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/local/bin", "/usr/share/bin", 
	 "/usr/contrib/bin", "/usr/gnu/bin", 
	 "/usr/bin", "/bin", "/usr/gnu/bin", "/usr/ucb",
	 "/usr/ucblib",  # NEC EWS4800 
	 # NT Extention
	 "/perl5/bin", 
	 "c:\\perl\\bin", "d:\\perl\\bin", "e:\\perl\\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";

    ### 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) = @_;
    
    print "Query(debug): ($menu, $query, $pat, $default)\n" if $debug;
    print "\n";

    while (1) {
	#print "menu={$menu} query={$query}\n";
	print "${CurTag}${menu} ($query) [$default] ";
	$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'};
    $LANGUAGE = $CurConfig{'LANGUAGE'};
    $TZ       = $CurConfig{'TZ'} || '+0900'; # COMPAT UNTIL FML 2.2;
    $VENDOR   = $CurConfig{'VENDOR'};

    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");
    }
}


sub GenCrontab
{
    local($uid);

    print STDERR "\n";
    print STDERR "   crontab: example for all ${USER}'s ML's is saved in\n";
    print STDERR "\t$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 /^\./;

	$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(CRAONTAB);
	    }
	}

    }
    closedir(DIRD);

    close(TAB);
}


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


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

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

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

    while (<F>) {
	chop;

	if (/^\#\s*$addr/i || /^$addr/i) {
	    $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') {
		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("${file}.new", $file) ||
		(&Warn("cannot rename $file.new $file"), return 0);

    chmod $mode, $file;

    print $sumbuf if $sumbuf;

    $found;
}


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


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

    # &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') {
	    $example = "$example.en";
	}
	# Japanese
	elsif ($LANGUAGE eq 'Japanese') {
	    $example = "$example.jp";
	}
	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"), return 0);
    select(CF); $| = 1; select(STDOUT);
    
    print STDERR "\t$out\n";

    if ($COMPAT_ARCH eq "WINDOWS_NT4") {
	$PERL_PATH = &search_path('perl.exe');
	$USER = $USER || $ENV{'USERNAME'};
    }
    else {
	$PERL_PATH = &search_path('perl');
	$uid   = $uid || (getpwuid($<))[2];
	$gid   = $gid || (getpwuid($<))[3];
    }

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

    # $STRUCT_SOCKADDR
    &SetSockAddr($CPU_TYPE_MANUFACTURER_OS);

    while (<EXAMPLE>) {
	# default
	$mail_list = $config{'MAIL_LIST'} || "$ml\@$DOMAIN";;
	$ctladdr   = "$ml-ctl\@$DOMAIN";

	# 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/_CTLADDR_/$ctladdr/g;
	s/_MAIL_LIST_/$mail_list/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;


	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) = (localtime($time||time))[0..6];
    $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, $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;

    print STDERR "\t$ML_DIR/$ml/config.h\n";

    if (open(GUESS, "> $ML_DIR/$ml/config.h")) {
	foreach $file (@include) {
	    if ( -f "$INCDIR/$file" ) {
		print GUESS "\#include <$file>\n";
	    }
	    else {
		# print STDERR "Not Found $INCDIR/$file\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";

    &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);

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

	if (! $passwd) {
	    # no echo
	    system "stty", "-echo";

	    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 (!$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");
    }
    else {
	print "   Passwd Change Fails ($passwd_file).\n";
	&Log("makefml::passwd changing $passwd_file fails");
    }

}


sub do_info
{
    print STDERR "*" x 60; print STDERR "\n";
    print STDERR "makefml Usage:\n\n";
    print STDERR "             makefml command\n";
    print STDERR "             makefml command <ML>  options\n";
    print STDERR "             makefml <ML>::command options\n";
    print STDERR "\n";

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

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

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

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

    print STDERR "\n";
    print STDERR "*" x 60; print STDERR "\n";
    print STDERR "\n";
    print STDERR "HOW TO INSTALL:\n";
    print STDERR "\"perl makefml install\" to INSTALL the fml\n";
    print STDERR "\"perl makefml config <ML>\" to go to the menu screen\n";
    print STDERR "\n";
}


sub do_install
{
    local($cmd);

    # main proc -> here;
    &InitFmlConfig;

    # initialize
    $NOT_CHECK_ML_EXIST = 1;

    # do_init
    {
	&ResetVariables;

	if (! -d $EXEC_DIR) {
	    print "   mkdir $EXEC_DIR\n";
	    &Mkdir($EXEC_DIR, 0755);		
	}

	if (! -d $ML_DIR) {
	    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", "n");
    }

    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/fml.pl");   print STDERR ".";
	&FixPath("src/msend.pl"); 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 "\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);
    }

    # backup temlate files when RE-INSTALLATION
    if (-d "$EXEC_DIR/drafts") {
	local($d, $f);

	$d = "$EXEC_DIR/drafts";
	opendir(DIRD, $d) || &Warn("cannot opendir $d");

	print STDERR "Back-up\'ing templates in $d ...\n";

	for $f (readdir(DIRD)) {
	    next if $f =~ /^\./;
	    next if $f =~ /\.bak$/i;	# /i for NT4.

	    $f = "$d/$f";
	    if (-f $f) { 
		&Copy($f, "$f.bak");
	    }
	}
	closedir(DIRD);
    }

    print STDERR "\nGenerating 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 "perl 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 $EXEC_DIR";
	eval symlink($CONFIG_DIR, "$EXEC_DIR/Configurations");
	&main'Warn($@) if $@; #';
    }
    else {
	print "Please do \"makefml\" in the top directory of the source\n";
    }

    if ($GroupWritable eq 'fmlserv') {
	$cmd = &Query("Set up \"fmlserv\" system now? ", "y/n", "y|n", "n");
	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;
    }
}


sub do_setq
{
    #print STDERR "setq \$Config'$_[0] = '$_[1]';\n"  if $debug;;
    eval("\$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)) {
	&Debug("*** 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");
	return;
    }

    if ($< == 0) { &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;

    &Conv($ml, "$EXEC_DIR/etc/makefml/cf", "$ML_DIR/$ml/cf");

    if (($OS_TYPE || $CPU_TYPE_MANUFACTURER_OS)
	 && open(CF, ">> $ML_DIR/$ml/cf")) {
	# CFVersio 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?;
    &Conv($ml, "$EXEC_DIR/etc/makefml/include", "$ML_DIR/$ml/include");
    &Conv($ml, "$EXEC_DIR/etc/makefml/include-ctl", "$ML_DIR/$ml/include-ctl");
    &Conv($ml, "$EXEC_DIR/etc/makefml/include-mead", 
	  "$ML_DIR/$ml/include-mead");


    &Conv($ml, "$EXEC_DIR/etc/makefml/aliases", "$ML_DIR/$ml/aliases");
    &Conv($ml, "$EXEC_DIR/etc/makefml/Makefile","$ML_DIR/$ml/Makefile");

    &SetPersonalUmask;	# umask 077;

    &Conv($ml, "$EXEC_DIR/etc/makefml/crontab", "$ML_DIR/$ml/crontab");
    &Conv($ml, "$EXEC_DIR/etc/makefml/fml.c",   "$ML_DIR/$ml/fml.c");
    &FixIncludeHeader;

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

    # drafts -> help,deny,guide,objective
    &CreateDocTemplate(*config, $ml);

    # 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");

    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
    print "\n";
    print "-" x 60;
    print "\n*** Please see several examples in directory '$ML_DIR/$ml'\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";

    # 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; 
}


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

    &ResetVariables;

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

    &CreateDocTemplate(*config, $ml);
}


sub CreateDocTemplate
{
    local(*config, $ml) = @_;
    local($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");
	}

	&Conv($ml, "$EXEC_DIR/drafts/$x", "$ML_DIR/$ml/$x");
    }

    return;

    # not reach here
    &Conv($ml, "$EXEC_DIR/drafts/help", "$ML_DIR/$ml/help");
    &Conv($ml, "$EXEC_DIR/drafts/help-admin", "$ML_DIR/$ml/help-admin");
    &Conv($ml, "$EXEC_DIR/drafts/deny", "$ML_DIR/$ml/deny");
    &Conv($ml, "$EXEC_DIR/drafts/guide", "$ML_DIR/$ml/guide");
    &Conv($ml, "$EXEC_DIR/drafts/welcome", "$ML_DIR/$ml/welcome");
    &Conv($ml, "$EXEC_DIR/drafts/confirm", "$ML_DIR/$ml/confirm");
    &Conv($ml, "$EXEC_DIR/drafts/objective", "$ML_DIR/$ml/objective");
}


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;
}


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);

    # 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");

    print STDERR "\t$qmail_alias_dir/.qmail-$ml-admin\n";
    &Write2($USER, "$qmail_alias_dir/.qmail-$ml-admin");

    print STDERR "\t$qmail_alias_dir/.qmail-$ml-request\n";
    &Write2($USER, "$qmail_alias_dir/.qmail-$ml-request");

    # 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 "\t$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("\\+$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");
    }
}


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

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

    &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);
	    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 ($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;
    }
}

# dummy functions agasint the compile errors of config.ph
sub DEFINE_SUBJECT_TAG { 1;}
sub DEFINE_MODE  { 1;}
sub DEFINE_FIELD_FORCED  { 1;}
sub DEFINE_FIELD_ORIGINAL { 1;}
sub DEFINE_FIELD_OF_REPORT_MAIL  { 1;}
sub DEFINE_FIELD_PAT_TO_REJECT { 1;}
sub DEFINE_FIELD_LOOP_CHECKED { 1;}
sub UNDEF_FIELD_LOOP_CHECKED  { 1;}
sub ADD_FIELD     { 1;}
sub DELETE_FIELD  { 1;}


package config_ph;
sub DEFINE_SUBJECT_TAG { 1;}
sub DEFINE_MODE  { 1;}
sub DEFINE_FIELD_FORCED  { 1;}
sub DEFINE_FIELD_ORIGINAL { 1;}
sub DEFINE_FIELD_OF_REPORT_MAIL  { 1;}
sub DEFINE_FIELD_PAT_TO_REJECT { 1;}
sub DEFINE_FIELD_LOOP_CHECKED { 1;}
sub UNDEF_FIELD_LOOP_CHECKED  { 1;}
sub ADD_FIELD     { 1;}
sub DELETE_FIELD  { 1;}
sub COPY_FIELD  { 1;}
sub ADD_CONTENT_HANDLER { 1;}
sub Load 
{
    local($f) = @_;
    eval require($f);
    $@;
}


package main;


sub GetConfigPH
{
    local($ml) = @_;
    local($status, $cf);

    &ResetVariables;

    $cf  = "$ML_DIR/$ml/config.ph";
    $DIR = "$ML_DIR/$ml";
    $config_ph'DIR = $main'DIR;
    $status = &config_ph'Load($cf); #';
    print STDERR $@ if $@;
}


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


# makefml pgp elena PGP-OPTIONS
sub do_pgp
{
    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);

    $xdir = &Value('PGP_PATH');
    $ENV{'PGPPATH'} = $xdir;
    &MkDirHier($xdir, 0700);
    
    $| = 1;
    print "\n--- PGP BEGIN ---\n";
    print "   PGPPATH = $ENV{'PGPPATH'}\n\n";

    &Log("makefml::pgp pgp @argv");
    system("pgp @argv");
    print STDERR "Error: $@" if $@;

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

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


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($pat) = $UNISTD ? '/|$' : '\\\\|/|$'; # on UNIX or NT4

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

	if ($` ne "" && !-d $`) {
	    mkdir($`, $_[1] || 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";

    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);
    }

    $UnderConfigTemplate = 1;

    # reset the current $EXEC_DIR/etc/makefml/cf to $ML_DIR/@/cf
    unlink $tmp_cf;
    &Copy($org_cf,  $tmp_cf);

    &do_config($ml);

    &Copy($tmp_cf, $org_cf);
    $UnderConfigTemplate = 0;

    # clean up
    unlink $tmp_cf;
    rmdir $dir;
}


sub do_config
{
    local($ml) = @_;
    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") {
	$t_cf       = (stat($cf))[9];
	$t_configph = (stat("$ML_DIR/$ml/config.ph"))[9];

	if ($t_cf < $t_configph) {
	    print "\n   *** Warning ***\n";
	    print &GetTime($t_cf); print "\n";
	    print &GetTime($t_configph); print "\n";
	    print "   Hmm... \"config.ph\" is newer than \"cf\" file\n";
	    print "   You had manually edited it, isn\'t it?\n\n";
	    print "   \"makefml config\" overwrites config.ph.\n";

	    local($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);#';

    # MAIN LOOP 
    &EachLevelQuery(*config, "/");

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

    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, @dir, @file);

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

    undef $file; for (@dir) { if (-f "$_/$f") { $file = "$_/$f";}}
    if (! $file) {
	&Log("makefml::edit_template cannot find $f");

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

	for (@dir) {
	    if (opendir(DIRD, $_)) {
		for (readdir(DIRD)) {
		    next if /^\./;
		    print "\t$_\n";
		}
		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 use(e.g. mule, ng, vi, ed ... default \"vi\") [vi] ";
	$editor = &GetString;
    }

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

    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_template operation ends");
}


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

    # "clear" not exist on NT4
    $clear_prog = $UNISTD ? &search_path('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); #';
	$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//; 

		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")) {
	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);

	print "---Configuration is 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(IN, $file) || (&Log("Grep: cannot open file[$file]"), return $NULL);
    while (<IN>) { return $_ if /$key/i;}
    close(IN);

    $NULL;
}

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

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

sub MakeConfigPH
{
    local($config, $manifest, $cf, $config_ph, $preamble) = @_;
    local($perl);

    if ($COMPAT_ARCH eq "WINDOWS_NT4") { 
	$perl = &search_path('perl.exe');
    }
    else {
	$perl = &search_path('perl');
    }

    if (! $perl) { 
	&Log("Error: makefml cannot find perl");
	print STDERR "I cannot find perl!! Dead Ends!\n";
	print STDERR "Hence I cannot make config.ph.\n";
	return "";
    }

    print STDERR "\n";
    print STDERR "   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;
	}
    }

    if (! open(EXEC_CF, "$perl $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;}
	if ($COMPAT_ARCH eq "WINDOWS_NT4") { unlink $config_ph;}
    }

    # write
    if (open(SAVE, "> $config_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 $config_ph");
	return $NULL;
    }

    print STDERR "Done.\n";
    print STDERR "\t(back-up is saved in $config_ph.bak)\n" if $back_up;

    # 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 "   $perl $config -m $manifest $cf > $config_ph\n\n";
	}
    }
}


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


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

sub do_adduser
{
    local($ml, $member) = @_;
    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\n");
	return;
    }

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

    &SetWritableUmask;

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

    if ($AdminMode) {
	@files = (&Value('ADMIN_MEMBER_LIST') ||
		  "$ML_DIR/$ml/members-admin");
    }
    else {
	push(@files, (&Value('MEMBER_LIST') || "$ML_DIR/$ml/members"));
	push(@files, (&Value('ACTIVE_LIST') || "$ML_DIR/$ml/actives"))
	    if &UseSeparateListP;
    }

    &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";
	return;
    }

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

    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");
	    next;
	}

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

    $ADDR_CHECK_MAX = $acm;
}


sub do_byeuser
{
    local($ml, $member) = @_;
    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\n");
	return;
    }

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

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

    &SetWritableUmask;

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

    &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";
	return;
    }

    # delete 
    local($file, $found);
    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;
	}
    }
}

# 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) = @_;
    local(@files);
    local($proc) = $fp;

    # 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");
	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 ***");
	    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\"");
    }

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

    # &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"));

    }
    else {
	push(@files, (&Value('ACTIVE_LIST') || "$ML_DIR/$ml/actives"));

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

    &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";
	return;
    }

    # delete 
    local($file, $found);
    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";
	}
    }
}


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_fmlserv
{
    print "---Configure fmlserv mailing list ... \n";

    # 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-fml.c",   "$ML_DIR/$ml/fml.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 "\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) = @_;
    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");
	return;
    }

    print "\n";
    print "   lock and sleep for $timeout secs.\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");
	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;

    &Conv($ml, $org, "$ML_DIR/$ml/$file");

    print "done.\n";
}


sub do_update
{
    local($ml, $file) = @_;
    local($x) = $file;
    local($t, $fail, $target);

    &ResetVariables;

    # file: $x
    $x =~ s#.*/##;
    $target = "$ML_DIR/$ml/$x";

    if (-f "$EXEC_DIR/etc/makefml/$x") {
	$t = "$EXEC_DIR/etc/makefml/$x";
    }
    elsif ($LANGUAGE eq 'Japanese') {
	if (-f "$EXEC_DIR/drafts/$x.jp") {
	    $t = "$EXEC_DIR/drafts/$x";
	}
    }
    elsif ($LANGUAGE eq 'English') {
	if (-f "$EXEC_DIR/drafts/$x.en") {
	    $t = "$EXEC_DIR/drafts/$x";
	}
    }

    print "\n   Updating $ML_DIR/$ml/$file ...\n\n";

    if ($t) {
	print "   Converting $t to \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";
	}
	else {
	    &Log("fail to rename $target.new $target");
	    $fail = 1;
	}

	if ($fail) {
	    print "   $target is NOT updated\n";
	}
	else {
	    print "   $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 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 ($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]);
    }
}

sub MakeSubDir
{
    local($info) = " GID=$GID" if $GID ne '';
    print "---Make Directory ($_[0])\t(UID=$<$info)\n";

    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);
    }
}


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) = @_;

    $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 =~ /^_/;

	    next if @vars && !grep($key eq $_,@vars);
	    local(*entry) = $val;

	    if (defined $entry) {
		$buf .= "\$$key = '$entry';\n";
	    }

	    if (defined @entry) {
		$buf .= "\@$key = (\n";
		foreach $num ($[ .. $#entry) {
		    $buf .= "  $num\t'$entry[$num]'\n";
		}
		$buf .= ");\n";
	    }

	    if ((($] !~ /5\.\d\d\d/) && 
		 $key ne "_$package" && $key ne "_DB" && defined %entry
		 )
		||
		(($] =~ /5\.\d\d\d/) && 
		 $key ne "$package::" && $key ne "DB::" && 
		 (defined %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; #';

    $lockdir  = "$mldir/$ml/";
    $lockdir .= $SPOOL_DIR{$ml} || "spool";

    # why $ml/$ml -> $ml conversion? (may be historical reason)
    # if (!-d $lockdir) { $lockdir  =~ s#$ml/$ml#$ml#;}

    $lockf = $main'UNISTD ? $lockdir : ">> $DIR/lockfile"; #';

    &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 main'V7Lock   { &v7'MakeFml_V7Lock(@_);}
sub main'V7UnLock { &v7'MakeFml_V7UnLock(@_);}

sub v7'SRand      { &main'SRand(@_);}
sub v7'Log        { &main'Log(@_);}
sub v7'Warn       { &main'Warn(@_);}
sub v7'WholeMail  { &main'WholeMail(@_);}
sub v7'SetEvent   { &main'SetEvent(@_);}


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) = (localtime($time||time))[0..6];
    $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, $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 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($pat) = $UNISTD ? '/|$' : '\\\\|/|$'; # on UNIX or NT4

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

	if ($` ne "" && !-d $`) {
	    mkdir($`, $_[1] || 0777) || do {
		&Log("cannot mkdir $`: $!"); 
		return 0;
	    };
	}
    }

    1;
}


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

    # reset variables used in liblock.pl
    for (FP_VARLOG_DIR, FP_VARRUN_DIR, LOCK_FILE, MAX_TIMEOUT) {
	eval "undef \$${_};";
	&main'Warn($@) if $@; #';
    }

    # global $DIR ;
    chop($CWD = `pwd`); # ATTENTION! ONLY ON UNIX
    $DIR = "$mldir/$ml";
    chdir $DIR;

    eval("do \"$mldir/$ml/config.ph\";");
    print STDERR "V7Lock::Error $@\n" if $@;
    &main'Warn($@) if $@; #';

    # variable fixes
    local($s);
    for (SPOOL_DIR,TMP_DIR,VAR_DIR,VARLOG_DIR,VARRUN_DIR,VARDB_DIR) {
	$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 MakeFml_V7Lock
{
    local($ml, $mldir) = @_;

    &LoadConfigPH($ml, $mldir);

    require 'liblock.pl';

    if ($debug) {
	print STDERR "\n";
	print STDERR "LOCK_FILE     $LOCK_FILE\n";
	print STDERR "FP_VARRUN_DIR $FP_VARRUN_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{$_};

	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 MakeFml_V7UnLock
{
    local($ml) = @_;

    $LockFile = $LockFile{$ml};

    require 'liblock.pl';
    &V7Unlock;
}


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));
	    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} .= $_;
	}
	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
    for (REMOTE_ADMINISTRATION, 
	 PASS_ALL_FIELDS_IN_HEADER,
	 @YES_OR_NO
	 ) {
	$SUMMARY{$_} = $config{$_} ? "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";
    }



    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 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);

    if ($s =~ /(_i_\s+)(\S+)/) {
	$index = $1;
	$label = $2;

	$index =~ s/_i_/sprintf("%-3s", $Count)/ge;
	$bind{$menu, $Count} = $label;

	# return value is rewritten .
	$label = $NAME{"/$label"} || $label;
    }

    $Count++;

    return "$index$label";
}


####### NT 
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 "perl $0 $cmd";

	$cmd = &Query("Do you continue?", "y/n", "y|n", "y");
	if ($cmd eq 'n') { last;}
    }
}


1;
