#!/usr/pkg/bin/perl
#
# Copyright (C) 1993-1998,2001 Ken'ichi Fukamachi
#          All rights reserved. 
#               1993-1996 fukachan@phys.titech.ac.jp
#               1996-1998,2001 fukachan@sapporo.iij.ad.jp
# 
# FML is free software; you can redistribute it and/or modify
# it under the terms of GNU General Public License.
# See the file COPYING for more details.
#
# $FML: fml_local.pl,v 2.7.2.1 2001/07/16 13:59:16 fukachan Exp $
#
$Rcdid   = "fml_local $rcsid";

$ENV{'PATH'}  = '/bin:/usr/ucb:/usr/bin';	# or whatever you need
$ENV{'SHELL'} = '/bin/sh' if $ENV{'SHELL'} ne '';
$ENV{'IFS'}   = '' if $ENV{'IFS'} ne '';

### MAIN ###
umask(077);

&FmlLocalInitialize;		# preliminary

chdir $HOME || die("Cannot chdir \$HOME=$HOME\n"); # meaningless but for secure

&FmlLocalReadCF($ConfigFile);	# set %Var, %Config, %_cf
&FmlLocalGetEnv;		# set %ENV, $DIR, ...

chdir $DIR  || die("Cannot chdir \$DIR=$DIR\n");

&FmlLocalFixEnv;
&Parse;				# Phase 1(1st pass), pre-parsing here
&GetFieldsFromHeader;		# Phase 2(2nd pass), extract headers
&FixHeaderFields(*Envelope);	# Phase 3, fixing fields information
&CheckCurrentProc(*Envelope);	# Phase 4, fixing environment and check loops

&FmlLocalSearch;		# pattern matching, and default set
&FmlLocalAdjustVariable;	# e.g. for $F1 ... and Reply-to: ...

&FmlLocalMainProc;		# calling the matched procedure && do default

exit 0;


################# LIBRALY ################# 


sub USAGE
{
    # Built in functions
    if (open(F, __FILE__)) {
	while(<F>) { 
	    /^\#\.USAGE:(.*)/ && ($UsageOfBuiltInFunctions .= "$1\n");
	}
	close(F);
    }

    # variables
    foreach (@Var) { 
	$variables .= " $_ ";
	$variables .= "\n" if (length($variables) % 65) < 3;
    }

    print STDERR <<"EOF";

$rcsid

USAGE: fml_local.pl [-Ddh] [-f ConfigFile] [-user username]
    -h     this help
    -d     debug mode on
    -D     dump variable 
    -f     configuration file for \~/.fmllocalrc
    -user  username

FILE:  \$HOME/.fmllocalrc

                  Please read FAQ for the details.

variables (set in \$HOME/.fmllocalrc):
$variables

BUILT-IN FUNCTIONS:
$UsageOfBuiltInFunctions

EXAMPLES for \~/.fmllocalrc
#field		pattern		type	exec

# "Subject: get filename"
# send \$ARCHIVE_DIR/filename to Reply-to: or From:
Subject    get\s+(\S+)            &       sendback

# MailBody is 
# "getmyspool password"
# send the owner's mailspool to the owner
body       getmyspool\s+(\S+)     &       getmyspool_pw

# Subject: guide
# send a \$ARCHIVE_DIR/guide to "From: address"
Subject    (guide)                  &       sendback

EOF

}


sub MailLocal
{
    # UMASK
    umask(077);

    # FLOCK paremeters
    $LOCK_SH = 1;
    $LOCK_EX = 2;
    $LOCK_NB = 4;
    $LOCK_UN = 8;

    # Do FLOCK
    if (open(MBOX, ">> $MAIL_SPOOL")) {
 	flock(MBOX, $LOCK_EX);
	seek(MBOX, 0, 2);
    }
    elsif (open(MBOX, ">> $HOME/mbox")) {
	flock(MBOX, $LOCK_EX);
	seek(MBOX, 0, 2);
    }
    elsif (open(MBOX, ">> $HOME/dead.letter")) {
	flock(MBOX, $LOCK_EX);
	seek(MBOX, 0, 2);
    }
    else {
	&Log("Can't open mailbox: $!");
	return 0;
    }

    # APPEND!
    &Log(">> $MAIL_SPOOL") if $debug;
    &Append2MBOX(0);

    # Unlock
    flock(MBOX, $LOCK_UN);
    close(MBOX);
}


sub Append2MBOX
{
    local($cut_unix_from) = 0;
    ($cut_unix_from) = @_;	# against "eval scalar of @_" context
    local(@s);

    # fflush()
    select(MBOX); $| = 1;

    ### Header
    @s = split(/\n/, $Envelope{'Header'});
    while(@s) {
	$_ = shift @s;
	next if (/^From /i && $cut_unix_from);

	print MBOX $_,"\n";
    }

    print MBOX "X-FML-LOCAL: ENFORCE MAIL.LOCAL\n";

    # separator between Header and Body
    print MBOX "\n";

    ### Body
    @s = split(/\n/, $Envelope{'Body'});
    while(@s) {
	$_ = shift @s;
	print MBOX ">" if /^From /i; # '>From'
	print MBOX $_,"\n";
    }

    # not newline terminated
    print MBOX "\n" unless $_ =~ /\n$/;

    # "\n"; allow empty message
    print MBOX "\n";
}


sub MailProc
{
    local($type, $exec) = @_;

    &Log("[$type]$exec") if $debug;

    # defaults
    if ($exec =~ /^mail\.local$/i) {
	&MailLocal || &Log($!);
    }

    # call "PERL" procedure
    elsif ($type =~ /^&$/o) { 
	# ($exec, @Fld) = split(/\s+/, $exec);
	(eval "&$exec();", $@ eq "") || &Log($@);
    }

    # cut unix from and PIPE OPEN
    elsif ($type =~ /^mh$/io) { 
	$exec .= " ". join(" ",@OPT);
	open(MBOX, "|-") || exec $exec || &Log($!);
    }

    # PIPE OPEN
    elsif ($type =~ /^\|$/o) { 
	$exec .= " ". join(" ",@OPT);
	open(MBOX, "|-") || exec $exec || &Log($!);
    }

    # APPEND!
    elsif ($type =~ /^>$/o) { 
	open(MBOX, ">>$exec") || &Log($!);
    }

    # GO! fflush() is done in sub Append2MBOX. 
    if ($type =~ /^mh$/i) {
	&Append2MBOX(1);
    }
    else {
	&Append2MBOX(0);
    }

    # CLOSE
    close(MBOX);
}


sub FmlLocalInitialize
{
    # first match version
    if ($0 =~ /fml_local2/) { $FIRST_MATCH  = 1;}

    # DEFAULTS
    $UnmatchP = 1;
    $NOT_TRACE_SMTP = 1;
    $NOT_USE_UNIX_FROM_LOOP_CHECK = 1;
    $FS = '\s+';			# DEFAULT field separator
    $ConfigFile = '';
    $HOST = 'localhost';

    $Envelope{'mci:mailer'} = 'ipc'; # use IPC(default)

    @Var = (HOME, DIR, LIBDIR, FML_PL, USER, MAIL_SPOOL, LOG, TMP,
	    TMP_DIR, PASSWORD, DEBUG, AND, ARCHIVE_DIR, VACATION,
	    MAINTAINER, MAINTAINER_SIGNATURE, FS,
	    LOG_MESSAGE_ID, SECURE_FML_LOCAL,
	    FIRST_MATCH, SLOCAL,
	    MY_FUNCTIONS, CASE_INSENSITIVE, MAIL_LENGTH_LIMIT);

    # getopts
    while(@ARGV) {
	$_ =  shift @ARGV;
	/^\-user/ && ($USER = shift @ARGV) && next; 
	/^\-f/    && ($ConfigFile = shift @ARGV) && next; 
	/^\-h/    && &USAGE && exit(0);
	/^\-d/    && ($debug++,   next);
	/^\-D/    && ($DUMPVAR++, next);
	-d $_     && push(@INC, $_);
    }

    # DEBUG
    if ($debug) {
	print STDERR "Getopt:\n";
	print STDERR "\$USER\t$USER\n";
	print STDERR "\$ConfigFile\t$ConfigFile\n\n";
    }

    # a few variables
    $USER = $USER || (getpwuid($<))[0];
    $HOME = (getpwnam($USER))[7] || $ENV{'HOME'};
    $FmlLocalRc   = "$HOME/.fmllocalrc";
    $FIRST_MATCH  = $SLOCAL;
    $LOGFILE      = "$HOME/fmllocallog"; # anyway logging

    if ($debug) {
	for (USER, HOME, FML_LOCAL_RC) {
	    eval "printf STDERR \"%-20s %s\\n\", '$_', \$$_;";
	}
    }
}


# %Var
# %Config 
sub FmlLocalReadCF
{
    local($infile) = @_;
    local($entry)  = 0;

    $infile = $infile || $FmlLocalRc;
    open(CF, $infile) || do {
	&Log("fail to open $infile");
	die "FmlLocalReadCF:$!\n";
    };

    ### make a pattern /$pat\s+(\S+)/
    foreach (@Var) { 
	$pat .= $pat ? "|$_" : $_;

	# for FmlLocal_get and 
	# next CF if $Var{$FIELD} in FmlLocalEntryMatch
	tr/A-Z/a-z/; # lower
	$Var{$_} = 1;
    }
    $pat = "($pat)";

    # FOR ARRAY
    $array_pat = "(INC)";

    ### Special pattern /$sp_pat\s+(.*)/
    # thanks to hirono@torii.nuie.nagoya-u.ac.jp (97/04/21)
    $sp_pat  = 'PASSWORD|MAINTAINER_SIGNATURE';
    $sp_pat .= '|TAR|UUENCODE|RM|CP|COMPRESS|ZCAT'; # system (.*) for "gzip -c"
    $sp_pat .= '|LHA|ISH'; # system (.*) for "gzip -c"
    $sp_pat  = "($sp_pat)";

    #### read config file
    CF: while(<CF>) {
	# Skip e.g. comments, null lines
	/^\s*$/o && $entry++ && next CF;
	next CF if /^\#/o;
	chop;

	# Set environment variables
	/^DEBUG/i && ($debug++, next CF);
	/^$sp_pat\s+(.*)/    && (eval "\$$1 = '$2';", $@ eq "") && next CF;
	/^$array_pat\s+(.*)/ && 
	    (eval "push(\@$1, '$2');", $@ eq "") && next CF;
	/^$pat\s+(\S+)/      && (eval "\$$1 = '$2';", $@ eq "") && next CF;

	# already must be NOT ENV VAR
	# AND OPERATION
	next CF if /^AND/i;
	$Config{$entry} .= $_."\n";

	# for later trick
	/^body/i && ($_PCB{'has-body-pat'} = 1);
    }

    close(CF);

    # record the number of matched entry
    $_PCB{'entry'} = $entry + 1;	# +1 is required for anti-symmetry
}


sub FmlLocalGetEnv
{
    # include ~/.fmllocalrc

    $HOME = $HOME || (getpwnam($USER))[7] || 
	    $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7] ||
		die("You are homeless!\n");

    $DIR         = $DIR         || $HOME;
    $LIBDIR      = $LIBDIR      || $DIR;
    $LOGFILE     = $LOG         || "$DIR/log";
    $ARCHIVE_DIR = $ARCHIVE_DIR || "$DIR/.archive";

    # Fix
    $USER = $USER || getlogin || (getpwuid($<))[0] || 
	die "Cannot define USER, exit\n";

    # Fix, after "chdir $DIR" 
    $TMP_DIR = $TMP_DIR || $TMP || "./tmp";
    $TMP_DIR =~ s/$DIR//g;
    &Log("TMP_DIR = $TMP_DIR") if $debug;

    if (! $MAIL_SPOOL) {
	for ("/var/mail", "/var/spool/mail", "/usr/spool/mail") {
	    $MAIL_SPOOL = "$_/$USER" if -r "$_/$USER";
	}
    }

    $VacationRc   = $VACATION || "$HOME/.vacationrc";

    if (! $domain) {
	$domain   = (gethostbyname('localhost'))[1];
	($domain) = ($domain =~ /(\S+)\.$/i) if $domain =~ /\.$/i;
	($domain) = ($domain =~ /localhost\.(\S+)/i); 
    }

    $MAINTAINER  = $MAINTAINER || $USER .'@'. $domain;
    
    # include ~/.vacationrc
    &FmlLocalReadCF($VacationRc) if -f $VacationRc;

    # logs message id against loopback
    $LOG_MESSAGE_ID = $LOG_MESSAGE_ID || "$TMP_DIR/log.msgid";

    if ($debug) {
	print STDERR "**********\n";
	for (@Var) { 
	    eval "printf STDERR \"%-20s %s\\n\", '$_', \$$_ if \$$_;";
	}
	print STDERR "**********\n";
    }

    1;
}


# FIX TO BE FIXED AFTER CHDIR $DIR;
sub FmlLocalFixEnv
{
    -d $TMP_DIR || &Mkdir($TMP_DIR, 0700);
}


# Predicate whether match or not 
# by comparing %Envelope{h:*} and $_CF
# trick:
#      body is 'body:' field :-) 
# this makes the code simple
#
# if has no 3rd entry, NOT ILLEGAL
# it must be AND OPERATION, REQUIRE 'multiple matching'
#
sub FmlLocalSearchMatch
{
    local($s, $entry)   = @_;
    local($f, $p, $type, $exec, @opt, $ok, $cnt);
    local($match) = 0;

    # $s = $_CF{$entry}; so "rc" entry;
    local(@pat) = split(/\n/, $s);

    # compare %Envelope patterns given by "rc" entry ($s)
    foreach $pat (@pat) {
	$cnt++;			# counter

	# field pattern type exec
	# ATTENTION! @OPT is GLOBAL
	($f, $p, $type, $exec, @opt) = split(/$FS/, $pat);
	print STDERR "  pat[$entry]:\t($f, $p, $type, $exec, @opt)\n" if $debug;

	$f =~ tr/A-Z/a-z/;	# lower

	if ($Envelope{"$f:"} =~ /$p/ || 
	    ($CASE_INSENSITIVE && $Envelope{"$f:"} =~ /$p/i)) {
	    print STDERR "MatchPat:\t[$f:$`($&)$']\n" if $debug;
	    &Log("Match [$f:$`($&)$']") if $debug;
	    $f1 = $1; $f2 = $2; $f3 = $3;
	    $ok++;

	    # MULTIPLE MATCH
	    if ($type && ($ok == $cnt)) {
		$match++;
		&FmlLocalSetVar($type, $exec, $f1, $f2, $f3);
		@OPT = @opt; # @opt eval may fail;
	    }
	}

	($f =~ /^default/i) && ($_PCB{'default'} = $pat);
    }

    $match;# return value;
}


sub FmlLocalSearch
{
    local($i, $r);

    # TRICK! deal MailBody like a body: field.
    # has-body-pat is against useless malloc 
    $Envelope{'body:'} = $Envelope{'Body'} if $_PCB{'has-body-pat'};

    # try to match pattern in %entry(.fmllocalrc) and *Envelope{Hdr,Body}
    for($i = 0; $i < $_PCB{'entry'}; $i++) {
	$_ = $Config{$i};
	next if /^\s*$/o;
	next if /^\#/o;

	# default is an exception
	if ($FIRST_MATCH && $r && (!/^default/i)) { next;}

	$r = &FmlLocalSearchMatch($_, $i);
    }
}


sub FmlLocalUnSetVar 
{ 
    for (TYPE, EXEC, F1, F2, F3) { eval "undef \$$_;";}
    undef @OPT;
}


# &FmlLocalSetVar($type, $exec, $F1, $F2, $F3, *opt);
sub FmlLocalSetVar
{
    local(@caller) = caller;

    &FmlLocalUnSetVar;

    # tricky global variable
    ($TYPE, $EXEC, $F1, $F2, $F3) = @_; 

    &Log("FmlLocalSetVar called at the line $caller[2]") if $debug;
    &Log("FmlLocalSetVar::($type, $exec, $f1, $f2, $f3)\n") if $debug;

    if ($debug) {
	for (TYPE, EXEC, F1, F2, F3) { eval "print \"$_ \$$_\\n\";";}
    }

    undef $UnmatchP;
}


sub FmlLocalReplace
{
    local($_) = @_;

    s/\$F1/$F1/g;
    s/\$F2/$F2/g;
    s/\$F3/$F3/g;
    s/\$From_address/$From_address/g;
    s/\$To_address/$To_address/g;
    s/\$Subject/$Subject/g;
    s/\$Reply_to/$Reply_to/g;
    s/\$HOME/$HOME/g;
    s/\$DIR/$DIR/g;
    s/\$LIBDIR/$LIBDIR/g;
    s/\$ARCHIVE_DIR/$ARCHIVE_DIR/g;
    s/\$TMP_DIR/$TMP_DIR/g;

    $_;
}

sub FmlLocalAdjustVariable
{
    # Headers
    $Reply_to              = $Envelope{'h:Reply-To:'};
    $Original_To_address   = $Envelope{'h:to:'};
    $To_address            = $Envelope{'h:to:'};
    $Original_From_address = $Envelope{'h:from:'};
    $Subject               = $Envelope{'h:subject:'};
    
    # variable expand
    $EXEC = &FmlLocalReplace($EXEC);
    for ($i = 0; $i < scalar(@OPT); $i++) {
	$OPT[$i] = &FmlLocalReplace($OPT[$i]);
    }

    1;
}


sub FmlLocalMainProc
{
    # Load user-defined-functions
    if (-f $MY_FUNCTIONS) {
	(eval "do '$MY_FUNCTIONS';", $@ eq "") || 
	    &Log("Cannot load $MY_FUNCTIONS");
    }

    # DEBUG OPTION
    if ($DUMPVAR) {
	require 'dumpvar.pl';
	&dumpvar('main');
    }

    # ENFORCE DROP TO THE MAIL SPOOL AGAINST INFINITE LOOP
    if (($Envelope{'x-fml-local:'} =~ /ENFORCE\s+MAIL.LOCAL/i)) {
	&Log("X-FML-LOCAL: ENFORCE mail.local") if $debug;
	&MailLocal;	
    }
    # IF UNMATCHED ANYWHERE, 
    # Default action equals to /usr/libexec/mail.local(4.4BSD)
    elsif ($UnmatchP) {
	print STDERR "\n&MailLocal;\n\n" if $debug;
	&Log("Default::mail.local") if $debug;
	&MailLocal;
    }
    else {
	if ($debug) {
	    $s  = "\n&MailProc($TYPE, $EXEC);\n";
	    $s .= "\twith F1=$F1 F2=$F2 F3=$F3\n"; 
	    $s .= "\twith \@OPT=(". join(" ", @OPT) .")\n";
	    print STDERR $s;
	}
	&Log("MailProc($TYPE, $EXEC)") if $debug;
	&MailProc($TYPE, $EXEC);
    }

    # default is "ALWAYS GO!"
    local($a, $b, $type, $exec);
    undef @OPT;
    ($a, $b, $type, $exec, @OPT) = split(/\s+/, $_PCB{'default'});
    if ($type) {
	print STDERR "\n *** ALWAYS GO! *** \n" if $debug;
	&FmlLocalSetVar($type, $exec, @OPT);
	&MailProc($TYPE, $EXEC);
    }
}


sub FmlLocalAppend2CF
{
    local($s) = @_;

    open(CF, ">> $FmlLocalRc") || (return 'open fail ~/.fmllocalrc');
    select(CF); $| = 1;
    print CF $s, "\n";
    close(CF);

    print CF "\n";

    return 'ok';
}


sub FmlLocalReadFML
{
    local($sepkey) = "\#\#\#\#\# SubRoutines \#\#\#\#\#";
    local($s);

    return '1;' unless -f $FML_PL;

    open(FML, $FML_PL) || 
	(print STDERR "Cannot load $FML_PL\n"  , return 0);

    while(<FML>) {
	next if 1 .. /^$sepkey/;
	$s .= $_;
    }

    close(FML);

    $s;
}


sub FmlLocalReadFile
{
    local($file, $package) = $_;
    local($s);

    open(FML, $file) || &Log("Cannot load $file\n");
    while(<FML>) { $s .= $_; }
    close(FML);

    $package = $package || 'main';
    "package $package;\n$s";
}



############################################################
##### INCLUDE Libraries
############################################################
if ($debug_fml_local) {
    eval(' chop ($PWD = `pwd`); ');
    $PWD = $ENV{'PWD'} || $PWD || '.'; # '.' is the last resort;)
    push(@INC, $PWD);
    push(@INC, "$PWD/proc");
    require 'libsmtp.pl'; 
    require 'libsmtputils.pl';
    require 'libkern.pl'; 
    require 'libdebug.pl';
}

### ---including #.include kern/libloadconfig.pl

#-*- perl -*-
#
# Copyright (C) 2000-2002 Ken'ichi Fukamachi
#          All rights reserved. 
# 
# FML is free software; you can redistribute it and/or modify
# it under the terms of GNU General Public License.
# See the file COPYING for more details.
#
# $FML: libloadconfig.pl,v 2.19.2.4 2003/12/13 02:00:31 fukachan Exp $
#

use vars qw($debug);
use vars qw($SiteInitPath $SiteforcePath $LoadConfigurationDone);


##
## Example:
##	$EXEC_DIR = $0; $EXEC_DIR =~ s@bin/.*@@;
##	push(@INC, $EXEC_DIR) if -d $EXEC_DIR;
##	push(@INC, $ENV{'PWD'}) if -d $ENV{'PWD'};
##	require 'libloadconfig.pl'; &__LoadConfiguration('__KERN__');
##            # _OR_
##	require 'libloadconfig.pl'; &__LoadConfiguration;
##

#    argv: __KERN__ or $NULL
# require: $DIR, @LIBDIR
#
sub __LoadConfiguration
{
    my ($space) = @_;

    if (! $DIR) {
	print STDERR "ERROR: __LoadConfiguration: \$DIR is not defined\n";
	&Log("ERROR: __LoadConfiguration: \$DIR is not defined");
	exit(1);
    }
    elsif (! -d $DIR) {
	print STDERR "ERROR: __LoadConfiguration: \$DIR not exsts\n";
	&Log("ERROR: __LoadConfiguration: \$DIR not exists");
	exit(1);
    }

    # reset to overload many times
    for (keys %INC) { delete $INC{$_} if /config.ph/;}

    # fix @INC to suppose
    # 1. $DIR
    # 2. $DIR/../etc/fml/ (e.g. /var/spool/ml/etc/fml/ )
    # 3. $EXEC_DIR (e.g. /usr/local/fml/)
    if (-d "$DIR/../etc/fml/") {
	unshift(@LIBDIR, "$DIR/../etc/fml/"); # ../etc for not UNIX OS
	unshift(@INC, "$DIR/../etc/fml/"); # ../etc for not UNIX OS
    }
    if (-d $DIR) {
	unshift(@LIBDIR, $DIR);
	unshift(@INC, $DIR);
    }

    require 'default_config.ph';

    &LoadSystemParams; # NOT USER BUT SYSTEM DEFINED PARAMETERS 

    # If this routine is used not within libkern.pl, 
    # fml.pl, we enforce to use dummy definitions to avoid errors.
    &LoadDummyMacros if $space ne '__KERN__';

    # site_init
    if ($SiteInitPath = &SearchFileInLIBDIR("site_init.ph")) {
	if (-r $SiteInitPath) { 
	    &Log("require $SiteInitPath") if $debug;
	    require($SiteInitPath);
	}
    }

    # include fundamental configurations and library
    if (-r "$DIR/config.ph")  { 
	require("$DIR/config.ph");
    }
    else {
	print STDERR "I cannot read $DIR/config.ph\n" if !-r "$DIR/config.ph";
	print STDERR "no $DIR/config.ph exist?\n" if !-f "$DIR/config.ph";
	print STDERR "FYI: FML Release 2 Release requires \$DIR/config.ph\n";
	exit 1;
    }

    # site_force
    for ("site_force.ph", "sitedef.ph") {
	($SiteforcePath = &SearchFileInLIBDIR($_)) || next;
	-r $SiteforcePath || next;

	&Log("require $SiteforcePath") if $debug;
	require($SiteforcePath);
	last;
    }

    # reset to overload many times to ensure next time loading
    for (keys %INC) {
	delete $INC{$_} if /config.ph/;
	delete $INC{$_} if /loadconfig.pl/;
    }

    $LoadConfigurationDone = 1;
}


# Descriptions: define global system parameters
#               USER SHOULD NOT CHANGE THESE PARAMETERS.
#    Arguments: none
# Side Effects: define global system parameters
# Return Value: none
sub LoadSystemParams
{
    # $debug options
    # XXX avoid the last 3 bit anyway.
    $DEBUG_OPT_VERBOSE_LEVEL_2 = 0x0002;
    $DEBUG_OPT_DELIVERY_ENABLE = 0x1000; # enabele delivery
}


sub SearchFileInLIBDIR
{
    for (@LIBDIR) { 
	&Debug("SearchFileInLIBDIR: <$_>/$_[0]") if $debug;
	if (-f "$_/$_[0]") { return "$_/$_[0]";}
    }
    $NULL;
}


### Section: User available macros in config.ph

# tricky
sub LoadDummyMacros
{
    eval "sub GET_HEADER_FIELD_VALUE { 1;}";
    eval "sub GET_ORIGINAL_HEADER_FIELD_VALUE { 1;}";
    eval "sub SET_HEADER_FIELD_VALUE { 1;}";
    eval "sub GET_ENVELOPE_VALUE { 1;}";
    eval "sub SET_ENVELOPE_VALUE { 1;}";
    eval "sub ENVELOPE_APPEND { 1;}";
    eval "sub ENVELOPE_PREPEND { 1;}";
    eval "sub GET_BUFFER_FROM_FILE { 1;}";

    eval "sub STR2JIS {1;}";
    eval "sub STR2EUC {1;}";
    eval "sub JSTR    {1;}";

    eval "sub DEFINE_SUBJECT_TAG          { 1;}";
    eval "sub DEFINE_MODE                 { 1;}";
    eval "sub DEFINE_FIELD_FORCED         { 1;}";
    eval "sub DEFINE_FIELD_ORIGINAL       { 1;}";
    eval "sub DEFINE_FIELD_OF_REPORT_MAIL { 1;}";
    eval "sub DEFINE_FIELD_PAT_TO_REJECT  { 1;}";
    eval "sub DEFINE_FIELD_LOOP_CHECKED   { 1;}";
    eval "sub UNDEF_FIELD_LOOP_CHECKED    { 1;}";

    eval "sub ADD_FIELD    { 1;}";
    eval "sub DELETE_FIELD { 1;}";
    eval "sub COPY_FIELD   { 1;}";
    eval "sub MOVE_FIELD   { 1;}";

    eval "sub ADD_CONTENT_HANDLER { 1;}";
    eval "sub DEFINE_MAILER       { 1;}";

    # procedure manipulation
    eval "sub PERMIT_PROCEDURE { 1;}";
    eval "sub DENY_PROCEDURE { 1;}";
    eval "sub DEFINE_PROCEDURE { 1;}";
    eval "sub PERMIT_ADMIN_PROCEDURE { 1;}";
    eval "sub DENY_ADMIN_PROCEDURE { 1;}";
    eval "sub DEFINE_ADMIN_PROCEDURE { 1;}";
    eval "sub DEFINE_MAXNUM_OF_PROCEDURE_IN_ONE_MAIL { 1;}";
    eval "sub DEFINE_MAXNUM_OF_ADMIN_PROCEDURE_IN_ONE_MAIL { 1;}";

    # misc
    eval "sub SIZE { ;}";

    # for convenience
    eval "sub DUMMY { ;}";
    eval "sub TRUE  { 1;}";
    eval "sub FALSE { \$NULL;}";
}

# hash control interface
sub GET_HEADER_FIELD_VALUE
{ 
    my ($hf) = @_;
    $hf = &FieldCapitalize($hf);
    $Envelope{"h:${hf}:"};
}

sub GET_ORIGINAL_HEADER_FIELD_VALUE
{ 
    my ($hf) = @_;
    $hf =~ tr/A-Z/a-z/;
    $Envelope{"h:${hf}:"};
}

sub SET_HEADER_FIELD_VALUE
{ 
    my ($hf, $value) = @_;
    $hf = &FieldCapitalize($hf);
    $Envelope{"h:${hf}:"} = $value;
}

sub GET_ENVELOPE_VALUE
{ 
    my ($key) = @_;
    $Envelope{$key};
}

sub SET_ENVELOPE_VALUE
{ 
    my ($key, $value) = @_;
    $Envelope{$key} = $value;
}

sub ENVELOPE_APPEND
{ 
    my ($key, $value) = @_;

    if (($key eq 'Body') && $Envelope{'h:Lines:'}) {
	my ($lines) = ($value =~ tr/\n/\n/);
	$Envelope{'h:Lines:'} += $lines;
    }

    $Envelope{$key} .= $value;
}

sub ENVELOPE_PREPEND
{ 
    my ($key, $value) = @_;
    
    if (($key eq 'Body') && $Envelope{'h:Lines:'}) {
	my ($lines) = ($value =~ tr/\n/\n/);
	$Envelope{'h:Lines:'} += $lines;
    }

    $Envelope{$key} = $value . $Envelope{$key};
}

sub GET_BUFFER_FROM_FILE
{
    my ($file) = @_;
    my ($buffer);

    if (open($file, $file)) {
	while (<$file>) {
	    $buffer .= $_;
	}
	close($file);
	$buffer;
    }
    else {
	&Log("GET_BUFFER_FROM_FILE: cannot open $file");
	$NULL;
    }
}

sub STR2JIS { &JSTR($_[0], 'jis');}
sub STR2EUC { &JSTR($_[0], 'euc');}
sub JSTR
{
    my ($s, $code) = @_;
    require 'jcode.pl';
    &jcode'convert(\$s, $code || 'jis'); #';
    $s;
} 

sub DEFINE_SUBJECT_TAG { &use('tagdef'); &SubjectTagDef($_[0]);}

sub DEFINE_MAILER
{
    my ($t) = @_;
    if ($t eq 'ipc' || $t eq 'prog') { 
	$Envelope{'mci:mailer'} = $t;
    }
    else {
	&Log("DEFINE_MAILER: unknown type=$t (shuold be 'ipc' or 'prog')");
    }
}

sub DEFINE_MODE
{ 
    my ($m) = @_;
    print STDERR "--DEFINE_MODE($m)\n" if $debug;

    $m =~ tr/A-Z/a-z/;
    $Envelope{"mode:$m"} = 1;

    # config.ph CFVersion == 3
    if ($CFVersion < 3) {
	&use("compat_cf2");
	&ConvertMode2CFVersion3($m);
    }

    if ($m =~ 
	/^(post=|command=|artype=confirm|ctladdr|disablenotify|makefml)/) {
	&Log("ignore $m call ModeDef") if $debug;
    }
    else {
	&Log("call ModeDef($m)") if $debug;
	&use("modedef"); 
	&ModeDef($m);
    }
}

sub DEFINE_FIELD_FORCED 
{ 
    local($_) = $_[0]; tr/A-Z/a-z/; $Envelope{"fh:$_:"} = $_[1];
    &ADD_FIELD(&FieldCapitalize($_));
}

sub DEFINE_FIELD_ORIGINAL
{ 
    local($_) = $_[0]; tr/A-Z/a-z/; $Envelope{"oh:$_:"} = 1;
    &ADD_FIELD(&FieldCapitalize($_));
}

sub DEFINE_FIELD_OF_REPORT_MAIL 
{ 
    my ($key, $value) = @_;

    $key = &FieldCapitalize($key);
    $Envelope{"GH:${key}:"} = $value;
    &ADD_FIELD($key);
}

sub DEFINE_FIELD_PAT_TO_REJECT
{ 
    my ($key, $value) = @_;
    $key =~ tr/A-Z/a-z/;
    $key = &FieldCapitalize($key);
    $REJECT_HDR_FIELD_REGEXP{ $key }        = $value;
    $REJECT_HDR_FIELD_REGEXP_REASON{ $key } = $value if $value;
}

sub DEFINE_FIELD_LOOP_CHECKED
{ 
    local($_) = $_[0]; tr/A-Z/a-z/;
    $LOOP_CHECKED_HDR_FIELD{$_} = 1;
}

sub UNDEF_FIELD_LOOP_CHECKED
{ 
    local($_) = $_[0]; tr/A-Z/a-z/;
    $LOOP_CHECKED_HDR_FIELD{$_} = 0;
}

sub ADD_FIELD
{ 
    my ($f) = @_;
    $f = &FieldCapitalize($f);
    grep(/^${f}$/i, @HdrFieldsOrder) || push(@HdrFieldsOrder, $f);
    &Debug("ADD_FIELD $f") if $debug;
}

sub DELETE_FIELD 
{
    my ($f) = @_;
    my (@h); 

    $f = &FieldCapitalize($f);

    # If $SKIP_FIELDS has no this entry.
    # print STDERR "    if ($SKIP_FIELDS !~ /\"\\|$f\\|\"/) { \n";
    if ($SKIP_FIELDS !~ /\|$f$|\|$f\|/) {
	$SKIP_FIELDS .= $SKIP_FIELDS ? "|$f" : $f;
    }

    for (@HdrFieldsOrder) { push(@h, $_) if $_ ne $f;}
    @HdrFieldsOrder = @h;
}

# the value is not inserted now.
sub COPY_FIELD 
{ 
    my ($old, $new) = @_; 

    # already %Envelope is ready to use.
    if ($LoadConfigurationDone || $Envelope{"h:${old}:"}) {
	my ($xold, $xnew);
	$xnew = &FieldCapitalize($new);
	$xold = &FieldCapitalize($old);
	$Envelope{"h:${xnew}:"} = $Envelope{"h:${xold}:"};
	$Envelope{"h:${xnew}:"} =~ s/\n$xold/\n$xnew/sgi;
    }
    else { # in *.ph files
	# XXX pass real operation to the later function
	# XXX while (($old,$new) = each %HdrFieldCopy) { ... } later
	$HdrFieldCopy{ $old } = $new;
    }

    &ADD_FIELD(&FieldCapitalize($new));
}

# the value is not inserted now.
sub MOVE_FIELD 
{ 
    &COPY_FIELD(@_);
    &DELETE_FIELD($_[0]);
}

# add Content Handler
sub ADD_CONTENT_HANDLER
{
    my ($bodytype, $parttype, $action) = @_;
    my ($type, $subtype, $xtype, $xsubtype);
   
    if ($bodytype eq '!MIME') {
	$type = '!MIME';
	$subtype = '.*';
    } else {
	($type, $subtype) = split(/\//, $bodytype, 2);
    }
    ($xtype, $xsubtype) = split(/\//, $parttype, 2);
    push (@MailContentHandler,
	  join("\t", $type, $subtype, $xtype, $xsubtype, $action));
}

# XXX overwritten by %LocaProcedure and @DenyProcedure
sub PERMIT_PROCEDURE
{
    my ($proc) = @_;

    push(@PermitProcedure, $proc);

    # may be defined by DENY_PROCEDURE() ?
    if ($LocalProcedure{$proc} eq 'ProcDeny') {
	delete $LocalProcedure{$proc};
    }

    # remove entry in @DenyProcedure
    if (@DenyProcedure) {
	my(@x, $x);
	for $x (@DenyProcedure) {
	    push(@x, $x) if $x ne $proc;
	}
	@DenyProcedure = @x;
    }
}

# XXX overwrite @PermitProcedure
sub DENY_PROCEDURE
{
    my ($proc) = @_;
    $LocalProcedure{$proc} = 'ProcDeny';
}

# set up Hash %LocalProcedure
sub DEFINE_PROCEDURE
{
    my ($proc, $fp) = @_;
    $LocalProcedure{$proc} = $fp;
}

sub DEFINE_MAXNUM_OF_PROCEDURE_IN_ONE_MAIL
{
    my ($proc, $n) = @_;
    $LocalProcedure{"l#${proc}"} = $n;
}


# XXX overwritten by %LocaAdminProcedure and @DenyAdminProcedure
sub PERMIT_ADMIN_PROCEDURE
{
    my ($proc) = @_;
    if ($proc !~ /^admin/) { $proc = "admin:proc";}

    push(@PermitAdminProcedure, $proc);

    # may be defined by DENY_ADMIN_PROCEDURE() ?
    if ($LocalAdminProcedure{$proc} eq 'ProcDeny') {
	delete $LocalAdminProcedure{$proc};
    }

    # remove entry in @DenyAdminProcedure
    if (@DenyAdminProcedure) {
	my(@x, $x);
	for $x (@DenyAdminProcedure) {
	    push(@x, $x) if $x ne $proc;
	}
	@DenyAdminProcedure = @x;
    }
}

# XXX overwrite @PermitAdminProcedure
sub DENY_ADMIN_PROCEDURE
{
    my ($proc) = @_;
    if ($proc !~ /^admin/) { $proc = "admin:proc";}
    $LocalAdminProcedure{$proc} = 'ProcDeny';
}

# set up Hash %LocalAdminProcedure
sub DEFINE_ADMIN_PROCEDURE
{
    my ($proc, $fp) = @_;
    if ($proc !~ /^admin/) { $proc = "admin:proc";}
    $LocalAdminProcedure{$proc} = $fp;
}

sub DEFINE_MAXNUM_OF_ADMIN_PROCEDURE_IN_ONE_MAIL
{
    my ($proc, $n) = @_;
    if ($proc !~ /^admin/) { $proc = "admin:proc";}
    $LocalAdminProcedure{"l#${proc}"} = $n;
}

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

# return total size reading from STDIN
sub SIZE
{
    return $Envelope{ _pcb }->{ incoming_message }->{ total_read_size };
}

# for conveinience
sub DUMMY { ;}
sub TRUE  { 1;}
sub FALSE { $NULL;}

1;
### ---end of including 


### ---including #.include kern/libsmtp.pl

# Smtp library functions, 
# smtp does just connect and put characters to the sockect.
# Copyright (C) 1993-2002 Ken'ichi Fukamachi
#          All rights reserved. 
#               1993-1996 fukachan@phys.titech.ac.jp
#               1996-2002 fukachan@sapporo.iij.ad.jp
# 
# FML is free software; you can redistribute it and/or modify
# it under the terms of GNU General Public License.
# See the file COPYING for more details.
#
# $FML: libsmtp.pl,v 2.42.2.8 2003/12/13 03:59:48 fukachan Exp $
#

no strict qw(subs);
use vars qw($debug $debug_smtp $debug_relay $USE_SMTP_PROFILE);  # debug
use vars qw($Total_Rcpt_Count $Current_Rcpt_Count); # stat information
use vars qw($IncrementCounterCalled); # global counter used in kern/fml.pl
use vars qw(%IncrementCounterCalled);
use vars qw($SmtpFeedMode);           # enforce smtpfeed use
use vars qw(@HOSTS @HOST);            # @HOST is for compatibility
use vars qw(%RelayRcpt %RELAY_GW %RELAY_NGW);
use vars qw(@RcptLists %SKIP);        # recipient not to deliver
use vars qw(%MCIWindowCB);            # delivery info shared between libsmtpmci
use vars qw($ExistSocketPH $SocketOK $FixTransparency); # cache
use vars qw($LastSmtpIOString $SocketTimeOut $SMTP_SORT_DOMAIN
	    $MCIType);



##### local scope in Calss:Smtp #####
my ($SoErrBuf, $RetVal, $SmtpTime, $FixTransparency, $Port);
my ($PipeLineCount, $PipeLineMaxRcvQueue);
my ($SmtpIOStart);
local($LastSmtpIOString);


# sys/socket.ph is O.K.?
sub SmtpInit
{
    local(*e, *smtp) = @_;

    # IF NOT SPECIFIED, [IPC]
    $e{'mci:mailer'} = $e{'mci:mailer'} || 'ipc';
    $e{'macro:s'}    = $e{'macro:s'}    || $FQDN;

    # Pipelining waiting receive queue length
    $PipeLineMaxRcvQueue = 100;

    # Set Defaults (must be "in $DIR" NOW)
    $SmtpTime  = time() if $TRACE_SMTP_DELAY;

    # LOG: on IPC and "Recovery for the universal use"
    if ($NOT_TRACE_SMTP || (!$VAR_DIR) || (!$VARLOG_DIR)) {
	$SMTP_LOG = '/dev/null';
    }
    else {
	(-d $VAR_DIR)    || &Mkdir($VAR_DIR);
	(-d $VARLOG_DIR) || &Mkdir($VARLOG_DIR);
	$SMTP_LOG = $SMTP_LOG || "$VARLOG_DIR/_smtplog";
	my ($org_smtp_log) = $SMTP_LOG;

	if ($USE_SMTP_LOG_ROTATE) {
	    eval { &use('modedef'); &RegistSmtpLogExpire; };

	    if ($SMTP_LOG_ROTATE_TYPE eq 'day') {
		my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime;
		$SMTP_LOG .= sprintf(".%04d%02d%02d", 
				    1900 + $year, $mon + 1, $mday);
	    }
	    else {
		my ($id) = &IncrementCounter("$VARLOG_DIR/.seq", 
					     $NUM_SMTP_LOG_ROTATE || 8);
		$SMTP_LOG .= ".$id" if $SMTP_LOG !~ /\.$id$/;

		# unlink $SMTP_LOG if first time in this process thread;
		if ($IncrementCounterCalled{"$VARLOG_DIR/.seq"} == 1) {
		    unlink $SMTP_LOG if -f $SMTP_LOG;
		    open($SMTP_LOG, ">$SMTP_LOG"); # XXX: prefer basic style
		    unlink $org_smtp_log if -f $org_smtp_log;
		    link($SMTP_LOG, $org_smtp_log)  if     $UNISTD;
		    &Copy($SMTP_LOG, $org_smtp_log) unless $UNISTD;
		}
	    }
	}
	else {
	    unlink $SMTP_LOG if -f $SMTP_LOG;
	}
    }

    ### FIX: . -> .. 
    ### rfc821 4.5.2 TRANSPARENCY, fixed by koyama@kutsuda.kuis.kyoto-u.ac.jp
    if (! $FixTransparency) {
	$FixTransparency = 1;	# Fixing is done once!

	undef $e{'preamble'} if $e{'mode:dist'};
	undef $e{'trailer'}  if $e{'mode:dist'};

	if ($e{'preamble'}) { 
	    $e{'preamble'} =~ s/\n\./\n../g; $e{'preamble'} =~ s/\.\.$/./g;
	}

	if ($e{'trailer'})  { 
	    $e{'trailer'} =~ s/\n\./\n../g;  $e{'trailer'} =~ s/\.\.$/./g;
	}
    }

    # update @RcptLists always when Smtp() starts.
    &__UpdateRcptLists();

    return 1 if $SocketOK;
    return ($SocketOK = &SocketInit);
}


# set up @RcptLists which has lists of recipients.
# Its purpose is to split lists to sub-organization but
# deliver to all of them. For example each admin maintains
# each labolatory. 
# @ACTIVE_LIST = (arrays of each laboratory actives).
# It is of no use if @ACTIVE_LIST == ($ACTIVE_LIST)
# which is true in almost cases.
# We should sort here? But the order may be of mean ...
sub __UpdateRcptLists
{
    @RcptLists = @ACTIVE_LIST;
    push(@RcptLists, $ACTIVE_LIST) 
	unless grep(/$ACTIVE_LIST/, @RcptLists);

    # SMTP HACK
    if ($USE_OUTGOING_ADDRESS) { 
	require 'libsmtphack.pl'; &SmtpHackInit;
    }
}


sub SocketInit
{
    my ($exist_socket_ph);

    for (@INC) { if (-r "$_/sys/socket.ph") { $ExistSocketPH = 1;}}

    $STRUCT_SOCKADDR = $STRUCT_SOCKADDR || 'n n a4 x8';

    ### PERL 5  
    if ($] =~ /^5\./) {
	eval("use Socket;");
	if ($@ eq '') {
	    &Log("Set Perl 5::Socket O.K.") if $debug;
	    return 1;
	}
    }

    ### PERL 4
    if ($ExistSocketPH) {
	eval("require 'sys/socket.ph';");
	$exist_socket_ph = $@ eq '' ? 1 : 0;
	&Log("\"eval sys/socket.ph\" O.K.") if $exist_socket_ph && $debug;
	return 1 if $exist_socket_ph; 
    }

    # COMPAT_SOLARIS2 is for backward compatibility.
    if ((! $exist_socket_ph) && 
	($COMPAT_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;};";
	&Log("Set socket [Solaris2]") if $debug;
    }
    elsif (! $exist_socket_ph) { # 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;};";
	&Log("Set socket [4.4BSD]") if $debug;
    }

    1;
}


# Connect $host to SOCKET "S"
# RETURN *error
sub SmtpConnect
{
    local(*host, *error) = @_;

    if ($USE_INET6) {
	my $mta = "$host:$Port" || 'localhost:25' || '[::1]:25';
	my $pkg = "Mail::Delivery";

	eval "use Socket6; require $pkg; $pkg->import();";
	unless ($@) {
	    my $service = new Mail::Delivery { 
		protocol     => 'SMTP', 
		log_function => \&Log,
	    };
	    &Log( $service->error() ) if $service->error();

	    if (defined $service) {
		$service->connect6( { _mta => $mta } );

		unless ( $service->error() ) {
		    if (defined $service->{ _socket }) {
			print SMTPLOG "socket ok (IPv6)\n";
			print SMTPLOG "connect ok (IPv6)\n";
			*S = $service->{ _socket };
			$error = "";
			return "";
		    }
		    else {
			&Log( $service->error() ) if $service->error();
			&Log("cannot connect $mta by IPv6");
		    }
		}
		else {
		    &Log( $service->error() );
		    &Log("cannot connect $mta by IPv6");
		}
	    }
	}
    }

    my ($pat)    = $STRUCT_SOCKADDR;
    my ($addrs)  = (gethostbyname($host = $host || 'localhost'))[4];
    my ($proto)  = (getprotobyname('tcp'))[2];
    my ($port)   = $Port || $PORT || (getservbyname('smtp', 'tcp'))[2];
    $port          = 25 unless defined($port); # default port

    # Check the possibilities of Errors
    return ($error = "Cannot resolve the IP address[$host]") unless $addrs;
    return ($error = "Cannot resolve proto")                 unless $proto;

    # O.K. pack parameters to a struct;
    my ($target) = pack($pat, &AF_INET, $port, $addrs);

    # IPC open
    if (socket(S, &PF_INET, &SOCK_STREAM, $proto)) { 
	print SMTPLOG "socket ok\n";
    } 
    else { 
	return ($error = "SmtpConnect: socket() error [$!]");
    }
    
    if (connect(S, $target)) { 
	print SMTPLOG "connect ok\n"; 
    } 
    else { 
	return ($error = "SmtpConnect: connect($host/$port) error[$!]");
    }

    ### need flush of sockect <S>;
    select(S); $| = 1; select(STDOUT);

    $error = "";
}


# delete logging errlog file and return error strings.
sub Smtp 
{
    local(*e, *rcpt, *files) = @_;
    local(@smtp);

    # Initialize, e.g. use Socket, sys/socket.ph ...
    &SmtpInit(*e, *smtp);
    
    # open LOG;
    open(SMTPLOG, ">> $SMTP_LOG") || (return "Cannot open $SMTP_LOG");
    select(SMTPLOG); $| = 1; select(STDOUT);

    ### cache Message-Id:
    if ($e{'h:Message-Id:'} || $e{'GH:Message-Id:'}) {
	&CacheMessageId(*e, $e{'h:Message-Id:'} || $e{'GH:Message-Id:'});
    }

    # main delivery routine:
    #    fml 3.0 does not use modulus type MCI.
    #    SmtpIO() handles recipient array window.
    my $error = &SmtpIO(*e, *rcpt, *smtp, *files);
    return $error if $error;

    # close log
    close(SMTPLOG);
    0; # return status BAD FREE();
}

# for (MCIWindow loop (1 times in almost cases)) {
#    open one of smtp servers (one of @HOSTS)
#        for $list (recipient lists) { # at fixed smtp server
#            set up window for each $list (window==0..end in almost cases)
#            send "RCPT TO:<$rcpt>" to socket;
#            # that is "send N-th region assigned for N-th server"
#            # but the N-th region (window) size varies from files to files. 
#        }
#    close smtp server
# }
sub SmtpIO
{
    local(*e, *rcpt, *smtp, *files) = @_;
    local(%smtp_pcb);

    # for (@HOSTS) { try to connect SMTP server ... }
    push(@HOSTS, @HOST);    # [COMPATIBLITY]
    unshift(@HOSTS, $HOST); # ($HOSTS, @HOSTS, ...);

    if ($USE_SMTP_PROFILE) { $SmtpIOStart = time;}

    undef %MCIWindowCB; # initialize MCI Control Block;

    &ConvHdrCRLF(*e);

    $Total_Rcpt_Count = 0;

    if ($e{'mode:__deliver'}) { # consider mci in distribute() 
	my $n = $MCI_SMTP_HOSTS > 1 ? $MCI_SMTP_HOSTS : 1;

	for (1 .. $n) { # MCI window loop
	    undef %smtp_pcb;
	    $smtp_pcb{'mci'} = 1 if $n > 1;

	    &__SmtpIOConnect(*e, *smtp_pcb, *rcpt, *smtp, *files);
	    return $smtp_pcb{'fatal'} if $smtp_pcb{'fatal'}; # fatal return

	    # @RcptLists loop under "fixed smtp server"
	    &__SmtpIO(*e, *smtp_pcb, *rcpt, *smtp, *files);
            $Total_Rcpt_Count += $Current_Rcpt_Count;

	    &__SmtpIOClose($smtp_pcb{'ipc'});

	    push(@HOSTS, $HOST); # last resort for insurance :)
	}
    }
    else { # e.g. command, message by Notify(), ...
	undef %smtp_pcb;
	$smtp_pcb{'mci'} = 0; # not use mci

	&__SmtpIOConnect(*e, *smtp_pcb, *rcpt, *smtp, *files);
	return $smtp_pcb{'fatal'} if $smtp_pcb{'fatal'}; # fatal return

	&__SmtpIO(*e, *smtp_pcb, *rcpt, *smtp, *files);
        $Total_Rcpt_Count += $Current_Rcpt_Count;

	&__SmtpIOClose($smtp_pcb{'ipc'});
    }
    &RevConvHdrCRLF(*e);

    if ($USE_SMTP_PROFILE) { &Log("SMTPProf: ".(time-$SmtpIOStart)."sec.");}

    $NULL;
}


# FYI: programs which accpets SMTP from stdio.
#   sendmail: /usr/sbin/sendmail -bs
#   qmail: /var/qmail/bin/qmail-smtpd (-bs?)
#   exim: /usr/local/exim/bin/exim -bs
#
sub __SmtpIOConnect
{
    local(*e, *smtp_pcb, *rcpt, *smtp, *files) = @_;
    local($host, $error);
    my ($sendmail, $backoff, $ipc, $retry);

    # set global variable
    $SocketTimeOut = 0; # against the call of &SocketTimeOut;
    # &SetEvent($TimeOut{'socket'} || 1800, 'SocketTimeOut') if $HAS_ALARM;

    # delay of retry 
    $backoff = 2;
    
    # IPC 
    if ($e{'mci:mailer'} eq 'ipc' || $e{'mci:mailer'} eq 'smtp') {
	$ipc = 1; # define [ipc]

	for ($host = shift @HOSTS; scalar(@HOSTS) >=0 ; $host = shift @HOSTS) {
	    undef $Port; # reset

	    if ($host =~ /(\S+):(\d+)/) {
		$host = $1;
		$Port = $2 || $PORT || 25;
	    }
	    else {
		$Port = $PORT || 25;
	    }

	    print STDERR "---SmtpIO::try smtp->host($host:$Port)\n"
		if $debug_smtp;

	    undef $error;
	    &SmtpConnect(*host, *error);  # if host is null, localhost
	    print STDERR "$error\n" if $error;

	    if ($error) {
		&Log($error); # error log BAD FREE();

		# but maximum is 30 sec.
		$backoff = 2 * $backoff;
		$backoff = $backoff > 30 ? 30 : $backoff;
		&Log("fml[$$] retry after $backoff sec.");
		$retry = 1; 
	    }
	    else { # O.K.
		&Log("fml[$$] send after $backoff sec.") if $retry;
		last;
	    }

	    sleep($backoff);	# sleep and try the secondaries

	    last unless @HOSTS;	# trial ends if no candidate of @HOSTS
	}
    }


    ###
    ### reaches here if mailer == prog or "smtp connection fails"
    ###

    # not IPC, try popen(sendmail) ... OR WHEN ALL CONNEVTION FAIL;
    # Only on UNIX
    if ($e{'mci:mailer'} eq 'prog' || $error) {
	undef $host;
	&Log("Try mci:prog since smtp connections not established") if $error;

	if ($UNISTD) {
	    $sendmail = $SENDMAIL || &SearchPath("sendmail") || 
		&SearchPath("qmail-smtpd", "/var/qmail/bin") ||
		    &SearchPath("exim", "/usr/local/exim/bin");
	    # fix argv options
	    if ($sendmail !~ /\-bs/) { $sendmail .= " -bs ";}

	    require 'open2.pl';
	    if (&open2(RS, S, $sendmail)) { 
		&Log("open2(RS, S, $sendmail)") if $debug;
	    }
	    else {
		&Log("SmtpIO: cannot exec $sendmail");
		$smtp_pcb{'error'} = "SmtpIO: cannot exec $sendmail";
		return $NULL;
	    };

	    $ipc = 0;
	}
	else {
	    &Log("cannot open prog mailer not under UNIX");
	    $smtp_pcb{'error'} = "SmtpIO: cannot prog mailer on not unix";
	    return $NULL;
	}
    }

    if ($USE_SMTP_PROFILE) { &Log("SMTP::Prof:connect $host/$Port");}

    # receive "220 ... sendmail ..." greeting
    if ($ipc) {
	do { print SMTPLOG $_ = <S>; &Log($_) if /^[45]/o;} while(/^\d+\-/o);
    }
    else {
	do { print SMTPLOG $_ = <RS>; &Log($_) if /^[45]/o;} while(/^\d+\-/o);
    }

    $smtp_pcb{'ipc'}      = $ipc;
    $smtp_pcb{'sendmail'} = $sendmail;
}

sub __SmtpIOClose
{
    my ($ipc) = @_;

    ### SMTP Section: QUIT
    # Closing Phase;
    &SmtpPut2Socket('QUIT', $ipc);

    close(S);
}

sub ConvHdrCRLF
{
    local(*e) = @_;

    $e{'Hdr'} =~ s/\n/\r\n/g; 
    $e{'Hdr'} =~ s/\r\r\n/\r\n/g; # twice reading;

    $NULL;
}

sub RevConvHdrCRLF
{
    local(*e) = @_;

    ### SMTP Section: save-excursion(?)
    # reverse \r\n -> \n
    $e{'Hdr'} =~ s/\r\n/\n/g;

    $NULL;
}


# Descriptions: check an article is deliverted today ?
#    Arguments: none
# Side Effects: none
# Return Value: NUM(1 or 0)
sub is_delivered_today
{
    my $status = 0;

    # must be in delivery mode
    if ($ID) {
	my $prev_id = $ID -1; 
	my $article = "$SPOOL_DIR/$prev_id";
	my ($mtime) = (stat($article))[9];
	my ($prev)  = (localtime($mtime))[3];
	my ($today) = (localtime(time))[3];

	if ($prev == $today) { return 1;}
    }

    return 0;
}


sub __SmtpIO
{
    local(*e, *smtp_pcb, *rcpt, *smtp, *files) = @_;
    my $retry = 0;
    my $ipc   = $smtp_pcb{'ipc'}; # SMTP PCB

    ### SMTP Section: HELO/EHLO
    $Current_Rcpt_Count = 0;
    $e{'mci:pipelining'} = 0; # reset EHLO information
    $e{'mci:xverp'}      = 0; # reset EHLO information

    if ($e{'mci:mailer'} eq 'smtpfeed' || $SmtpFeedMode) {
	&SmtpPut2Socket("LHLO $e{'macro:s'}", $ipc);
    }
    else {
	&SmtpPut2Socket("EHLO $e{'macro:s'}", $ipc, 1, 1); # error ignore mode 

	# EHLO fails (smap returns 500 ;_;, may not 554)
	if ($SoErrBuf =~ /^5/) {
	    &SmtpPut2Socket("HELO $e{'macro:s'}", $ipc);
	}
	elsif ($RetVal =~ /250.PIPELINING/) {
	    $e{'mci:pipelining'} = 1;
	}

	# Postfix XVERP
	if ($RetVal =~ /250.XVERP/) {
	    $e{'mci:xverp'} = 1;
	}

	undef $SoErrBuf;
    }

    $e{'mci:pipelining'} = 0 if $NOT_USE_ESMTP_PIPELINING;


    ### SMTP Section: MAIL FROM:

    # [VERPs]
    # XXX MAIL FROM:<mailing-list-maintainer@domain>
    # XXX If USE_VERP (e.g. under qmail), you can use VERPs
    # XXX "VERPs == Variable Envelope Return-Path's".

    # XXX only for postfix
    # try verp per day for effecient delivery
    $SavedVerps = $USE_VERP;
    if ($USE_VERP && $TRY_VERP_PER_DAY) {
	if (is_delivered_today()) { 
	    $USE_VERP = 0;
	}
	else {
	    &Log("try VERPs once today");
	}
    }

    {
	my ($mail_from, $xverp);
	if ($USE_VERP) {
	    # postfix xverp
	    if ($e{'mci:xverp'}) {
		# Example: elena-admin+rudo=nuiniu.net@fml.org
		# you need set up alias
		#    elena-admin: :include:/var/spool/ml/include-mead
		my $vd = $POSTFIX_VERP_DELIMITERS || '+=';
		$xverp = " XVERP=$vd";
		$mail_from = $SMTP_SENDER || $MAINTAINER;
	    }
	    # qmail
	    else {
		$mail_from = $SMTP_SENDER || $MAINTAINER;
		$mail_from =~ s/\@/-\@/;
		$mail_from .= '-@[]';
	    }
	} else {
	    $mail_from = $SMTP_SENDER || $MAINTAINER;
	}
	&SmtpPut2Socket("MAIL FROM:<$mail_from>$xverp", $ipc);
    }
    
    if ($SoErrBuf =~ /^[45]/) {
	&Log("SmtpIO ERROR: smtp session stop and NOT SEND ANYTHING!");
	&Log("reason: $SoErrBuf");
	return $NULL;
    }


    ### SMTP Section: RCPT TO:

    if ($USE_SMTP_PROFILE) { &GetTime; print SMTPLOG "RCPT  IN>$MailDate\n";}

    if ($e{'mode:__deliver'} && $USE_OUTGOING_ADDRESS) { 
	if ($e{'mci:pipelining'}){
	    &SmtpPut2Socket_NoWait("RCPT TO:<$OUTGOING_ADDRESS>", $ipc);
	}
	else {
	    &SmtpPut2Socket("RCPT TO:<$OUTGOING_ADDRESS>", $ipc);
	}
	    
	$Current_Rcpt_Count = 1;
    }
    elsif ($e{'mode:__deliver'}) { 
	if ($SMTP_SORT_DOMAIN) { &use('smtpsd'); &SDInit(*RcptLists);}

	my (%a, $a);
	for $a (@RcptLists) { # plural active lists
	    next if $a{$a}; $a{$a} = 1; # uniq;
	    &SmtpPutActiveList2Socket(*smtp_pcb, $ipc, $a);
	}

	if ($SMTP_SORT_DOMAIN) { &SDFin(*RcptLists);}
    }
    elsif ($e{'mode:delivery:list'}) { 
	&SmtpPutActiveList2Socket(*smtp_pcb, $ipc, $e{'mode:delivery:list'});
    }
    else { # [COMPATIBILITY] not-DLA is possible;
	my ($lc_rcpt);
	for (@rcpt) { 
	    $Current_Rcpt_Count++ if $_;

	    $lc_rcpt = $_;
	    $lc_rcpt =~ tr/A-Z/a-z/;

	    # Relay Hack; always enable %RelayRcpt
	    $_ = $RelayRcpt{$lc_rcpt} if $RelayRcpt{$lc_rcpt};

	    if ($e{'mci:pipelining'}){
		&SmtpPut2Socket_NoWait("RCPT TO:<$_>", $ipc) if $_;
	    }
	    else {
		&SmtpPut2Socket("RCPT TO:<$_>", $ipc) if $_;
	    }
	}
    }

    if ($USE_SMTP_PROFILE) { &GetTime; print SMTPLOG "RCPT OUT>$MailDate\n";}

    # if no rcpt (e.g. MCI_SMTP_HOSTS > 1,  crosspost and compination of them)
    # "DATA" without "RCPT" must be error;
    if ($Current_Rcpt_Count == 0) {
	&Log("SmtpIO: no recipients but O.K.?");
	&SmtpPut2Socket('QUIT', $ipc);
	return;
    }


    ### SMTP Section: DATA

    if ($e{'mci:pipelining'}) {
	&SmtpPut2Socket_NoWait('DATA', $ipc);
	&WaitFor354($ipc);
    }
    else {
	&SmtpPut2Socket('DATA', $ipc, 1);
    }

    # "DATA" Session BEGIN; no reply via socket
    # BODY INPUT ; putheader()
    print SMTPLOG ('-' x 30), "\n";
    $0 = "${FML}:  BODY <$MyProcessInfo>";

    print SMTPLOG $e{'Hdr'};
    print S $e{'Hdr'};	# "\n" == separator between body and header;
    print SMTPLOG "\r\n";
    print S "\r\n";

    # Preamble
    if ($e{'preamble'}) { 
	$e{'preamble'} =~ s/\n/\r\n/g; 
	$e{'preamble'} =~ s/\r\r\n/\r\n/g; # twice reading;
	print SMTPLOG $e{'preamble'}; 
	print S $e{'preamble'};
    }

    # Put files as a body
    if (@files) { 
	&SmtpFiles2Socket(*files, *e);
    }
    # BODY ON MEMORY
    else { 
	# Essentially we request here only "s/\n/\r\n/ && print"!
	# We should not reference body itself by s///; since
	# it leads to big memory allocation.
	{
	    my ($pp, $p, $maxlen, $len, $buf, $pbuf);

	    $pp     = 0;
	    $maxlen = length($e{'Body'});

	    # write each line in buffer
	  smtp_io:
	    while (1) {
		$p   = index($e{'Body'}, "\n", $pp);
		$len = $p  - $pp + 1;
		$buf = substr($e{'Body'}, $pp, ($p < 0 ? $maxlen-$pp : $len));
		if ($buf !~ /\r\n$/) { $buf =~ s/\n$/\r\n/;}

		# ^. -> ..
		$buf =~ s/^\./../;

		print SMTPLOG $buf;
		print S $buf;
		$LastSmtpIOString = $buf;

		last smtp_io if $p < 0;
		$pp = $p + 1;
	    }
	}

	# global interrupt;
	if ($Envelope{'ctl:smtp:stdin2socket'}) {
	    my ($pbuf, $buf);
	    while (sysread(STDIN, $buf, 1024)) {
		$buf =~ s/\n/\r\n/g;
		$buf =~ s/\r\r\n/\r\n/g; # twice reading;

		# ^. -> .. 
		$buf =~ s/\n\./\n../g;

		# XXX: 1. "xyz\n.abc" => "xyz\n" + ".abc"
		# XXX: 2. "xyz..abc" => "xyz." + ".abc"
		if ($pbuf =~ /\n$/) { $buf =~ s/^\./../g;}
		if ($pbuf eq '') { $buf =~ s/^\./../g;} # the first time

		print S $buf;
		$pbuf = substr($buf, -4); # the last buffer
	    }

	    print SMTPLOG "\n\n... truncated in log for file system ...\n";
	    $LastSmtpIOString = substr($_, -16);
	}
	else {
	    $LastSmtpIOString = substr($e{'Body'}, -16);
	}
    }

    # special exceptions;
    if ($e{'Body:append:files'}) {
	local(@append) = split($;, $e{'Body:append:files'});
	&SmtpFiles2Socket(*append, *e);
	undef $e{'Body:append:files'};
    }

    # special control: direct buffer copy from %Envelope.
    if ($Envelope{'ctl:smtp:ebuf2socket'}) {
	require 'libsmtpsubr.pl';

	if ($Envelope{'ctl:smtp:forw:ebuf2socket'}) {
	    print S &ForwardSeparatorBegin;
	    print SMTPLOG &ForwardSeparatorBegin;
	}

	&Copy2SocketFromHash('Header');

	# Separator between Header and Body
	print SMTPLOG "\r\n";
	print S "\r\n";

	&Copy2SocketFromHash('Body');

	if ($Envelope{'ctl:smtp:forw:ebuf2socket'}) {
	    print S &ForwardSeparatorEnd;
	    print SMTPLOG &ForwardSeparatorEnd;
	}
    }

    # Trailer
    if ($e{'trailer'}) { 
	$e{'trailer'} =~ s/\n/\r\n/g; 
	$e{'trailer'} =~ s/\r\r\n/\r\n/g; # twice reading;
	$LastSmtpIOString =  $e{'trailer'}; 
	print SMTPLOG $e{'trailer'}; 
	print S $e{'trailer'};
    }

    ## close smtp with '.'
    print S "\r\n" unless $LastSmtpIOString =~ /\n$/;	# fix the last 012
    print SMTPLOG ('-' x 30), "\n";

    ## "DATA" Session ENDS; ##
    &SmtpPut2Socket("\r\n.", $ipc);

    # saved value	    
    $USE_VERP = $SavedVerps;

    $NULL;
}


sub SocketTimeOut
{
    $SocketTimeOut = 1;
    close(S);
}


sub SmtpPut2Socket_NoWait
{
    $PipeLineCount++; # the number of wait after 'DATA' request.
    &SmtpPut2Socket(@_, 0, 0, 1);
}


sub GetPipeLineReply
{
    my ($ipc) = @_;    
    my ($wc)  = int($PipeLineCount/2);
    while ($wc-- > 0) {
	&WaitForSmtpReply($ipc, 1, 0);
	$PipeLineCount--;
    }
}


# XXX If $Current_Rcpt_Count is no longer used, 
# XXX remove it! (must be true in the future. logged on 1999/06/21).
sub WaitFor354
{
    my ($ipc) = @_;
    my ($wc) = $PipeLineCount + 1; 

    while ($wc-- > 0) {
	undef $RetVal;
	&WaitForSmtpReply($ipc, 1, 0);
	last if $RetVal =~ /^354/;
    }

    $PipeLineCount = 0;
}


sub WaitForSmtpReply
{
    my ($ipc, $getretval, $ignore_error) = @_;
    my ($buf);

    if ($ipc) {
	do { 
	    print SMTPLOG ($buf = <S>); 
	    $RetVal .= $buf if $getretval;
	    $SoErrBuf = $buf if $buf =~ /^[45]/o;
	    &Log($buf) if $buf =~ /^[45]/o && (!$ignore_error);
	} while ($buf =~ /^\d+\-/o);
    }
    else {
	do { 
	    print SMTPLOG $_ = <RS>; 
	    $RetVal .= $_ if $getretval;
	    $SoErrBuf = $_  if /^[45]/o;
	    &Log($_) if /^[45]/o && (!$ignore_error);
	} while (/^\d+\-/o);
    }
}


sub SmtpPut2Socket
{
    my ($s, $ipc, $getretval, $ignore_error, $no_wait) = @_;

    # return if $s =~ /^\s*$/; # return if null;

    $0 = "${FML}:  $s <$MyProcessInfo>"; 
    print SMTPLOG $s, "<INPUT\n";
    print S $s, "\r\n";

    # no wait
    return $NULL if $no_wait;

    # wait for SMTP Reply
    &WaitForSmtpReply($ipc, $getretval, $ignore_error);

    # Approximately correct :-)
    if ($TRACE_SMTP_DELAY) {
	my $time = time() - $SmtpTime;
	$SmtpTime = time();
	&Log("SMTP DELAY[$time sec.]:$s") if $time > $TRACE_SMTP_DELAY;
    }

    $RetVal;
}


# %RELAY_SERVER = ('ac.jp', 'relay-server', 'ad.jp', 'relay-server');
sub SmtpPutActiveList2Socket
{
    local(*smtp_pcb, $ipc, $file) = @_;
    my ($rcpt, $lc_rcpt, $gw_pat, $ngw_pat, $relay);
    my ($mci_count, $count, $time, $filename, $xtime);
    my ($size, $mci_window_start, $mci_window_end);
    my (%WMD, $myml); # for crosspost operation

    $filename = $file; $filename =~ s#$DIR/##;

    # Relay Hack
    if ($CF_DEF && $RELAY_HACK) { require 'librelayhack.pl'; &RelayHack;}
    if (%RELAY_GW)  { $gw_pat  = join("|", sort keys %RELAY_GW);}
    if (%RELAY_NGW) { $ngw_pat = join("|", sort keys %RELAY_NGW);}

    if ($debug_relay) { 
	my ($k, $v);
	print STDERR "gw_pat=$gw_pat\nngw_pat=$ngw_pat\n";
	while (($k,$v) = each %RELAY_GW) { 
	    print STDERR " RELAY_GW: $k => $v\n";
	}
	while (($k,$v) = each %RELAY_NGW) { 
	    print STDERR "RELAY_NGW: $k => $v\n";
	}
    }

    $MCIType = 'window'; # no more modulus
    if ($smtp_pcb{'mci'}) {
	require 'libsmtpsubr2.pl';
	($size, $mci_window_start, $mci_window_end) = &GetMCIWindow($file);
    }

    # when crosspost, delivery info is saved in crosspost.db;
    if ($USE_CROSSPOST) { 
	dbmopen(%WMD, "$FP_VARDB_DIR/crosspost", 0400);
	$myml = $MAIL_LIST;
	$myml =~ tr/A-Z/a-z/;
    }


    ##                                                          ##
    ## MAIN IO from recipients list to Socket (SMTP Connection) ##
    ##                                                          ##
    if ($debug_smtp) { &Log("--SmtpPutActiveList2Socket:open $file");}
    $time = time;
    $mci_count = $count = 0;

    open(ACTIVE_LIST, $file) || do {
	&Log("SmtpPutActiveList2Socket: cannot open $file");
	return 0;
    };

    while (<ACTIVE_LIST>) {
	chop;

	print STDERR "\nRCPT ENTRY\t$_\n" if ($debug_smtp);

	next if /^\#/o;	 # skip comment and off member
	next if /^\s*$/o; # skip null line
	next if /\s[ms]=/o;

	# O.K. Checking delivery and addrs to skip;
	($rcpt) = split(/\s+/, $_);

	# Address Representation Range Check
	# local-part is /^\S+$/ && /^[^\@]$/ is enough effective, is'nt it?
	&ValidAddrSpecP($rcpt) || ($rcpt =~ /^[^\@]+$/) || do {
	    &Log("$filename:$. <$rcpt> is invalid");
	    next;
	};

	$lc_rcpt = $rcpt;
	$lc_rcpt =~ tr/A-Z/a-z/; # lower case;

	# skip case, already loop-check-code-in %SKIP;
	next if $SKIP{$lc_rcpt}; 

	# skip if crosspost and the ml to deliver != $MAIL_LIST;
	if ($USE_CROSSPOST) {
	    if ($WMD{$lc_rcpt} && ($WMD{$lc_rcpt} ne $myml)) {
		print STDERR "SKIP FOR CROSSPOST [$WMD{$lc_rcpt} ne $myml]\n"
		    if $debug_smtp;
		next;
	    }
	}

	# Relay Hack;
	$rcpt = $RelayRcpt{$lc_rcpt} if $RelayRcpt{$lc_rcpt};

	# %RELAY_GW 
	# attention! $gw_pat is "largest match";
	if ($gw_pat && $rcpt =~ /^\@/ && $rcpt =~ /($gw_pat)[,:]/i) {
	    if ($relay = $RELAY_GW{$1}) { $rcpt = "\@${relay},${rcpt}";}
	}
	elsif ($gw_pat && $rcpt =~ /($gw_pat)$/i) {
	    if ($relay = $RELAY_GW{$1}) { $rcpt = "\@${relay}:${rcpt}";}
	}

	if ($debug_smtp) {
	    my $ok = $rcpt !~ /($ngw_pat)/i ? 1 : 0;
	    &Debug("$rcpt !~ /($ngw_pat)[,:]/i rewrite=$ok") if $debug_relay;
	}

	# %RELAY_NGW (negative relay gataway)
	# attention! $ngw_pat is "largest match";
	if ($ngw_pat) {
	    if ($rcpt =~ /^\@/ && ($rcpt !~ /($ngw_pat)[,:]/i)) {
		$relay = &SearchNegativeGw($rcpt, 1);
		$rcpt = "\@${relay},${rcpt}" if $relay;
	    }
	    elsif ($rcpt !~ /($ngw_pat)$/i) {
		$relay = &SearchNegativeGw($rcpt);
		$rcpt = "\@${relay}:${rcpt}" if $relay;
	    }
	}

	# count and do delivery for each modulus sets;
	$mci_count++;

	### Window Control ###
	# PLURAL SMTP SERVERS
	if ($smtp_pcb{'mci'}) {
	    if ($MCIType eq 'window') {
		# $mci_count++ before but $count++ after here.
		# Suppose (first, last) = (0, 100), (100, 200), ...
		# we pass throught 0-99, 100-199, ...
		next if $mci_count <= $mci_window_start; #   0 100 200
		last if $mci_count >  $mci_window_end;   # 100 200 300
	    }
	}
	# SINGLE SMTP SERVER
	else {
	    ;
	}
	### Window Control ends ###

	$count++; # real delivery count;

	if ($USE_SMTP_PROFILE) { $xtime = time;}

	if ($e{'mci:pipelining'}){
	    &SmtpPut2Socket_NoWait("RCPT TO:<$rcpt>", $ipc);
	}
	else {
	    &SmtpPut2Socket("RCPT TO:<$rcpt>", $ipc);
	}

	if ($USE_SMTP_PROFILE && (time - $xtime > 1)) { 
	    &Log("SMTP::Prof $rcpt slow");
	}

	if ($e{'mci:pipelining'} && ($PipeLineCount > $PipeLineMaxRcvQueue)) {
	    &GetPipeLineReply($ipc);
	}

	$Current_Rcpt_Count++;
    }

    close(ACTIVE_LIST);
    dbmclose(%WMD);

    &Log("Smtp: ".(time - $time)." sec. for $count rcpts.") if $debug_smtp;
    if ($USE_SMTP_PROFILE && ((time - $time) > 0)) {
	&Log("SMTP::Prof:RCPT ".(time - $time)." sec. for $count rcpts.");
    }
}

###FI: NOT EXPORTS IN FIX-INCLUDE
# SMTP UTILS;
sub SmtpFiles2Socket { require 'libsmtpsubr.pl'; &DoSmtpFiles2Socket(@_);}
sub NeonSendFile     { require 'libsmtputils.pl'; &DoNeonSendFile(@_);}
sub SendFile         { require 'libsmtputils.pl'; &DoSendFile(@_);}
sub SendFile2        { require 'libsmtputils.pl'; &DoSendFile2(@_);}
sub SendFile3        { require 'libsmtputils.pl'; &DoSendFile3(@_);}
sub SendPluralFiles  { require 'libsmtputils.pl'; &DoSendPluralFiles(@_);}
sub Sendmail         { require 'libsmtputils.pl'; &DoSendmail(@_);}
sub GenerateMail     { &GenerateHeaders(@_);}
sub GenerateHeaders  { &GenerateHeader(@_);}
sub GenerateHeader   { require 'libsmtputils.pl'; &DoGenerateHeader(@_);}

1;
### ---end of including 


### ---including #.include kern/libsmtputils.pl

#-*- perl -*-
#
# Smtp library functions, 
# smtp does just connect and put characters to the sockect.
# Copyright (C) 1993-2001 Ken'ichi Fukamachi
#          All rights reserved. 
#               1993-1996 fukachan@phys.titech.ac.jp
#               1996-2001 fukachan@sapporo.iij.ad.jp
# 
# FML is free software; you can redistribute it and/or modify
# it under the terms of GNU General Public License.
# See the file COPYING for more details.
#
# $FML: libsmtputils.pl,v 2.12.2.3 2003/12/13 01:39:16 fukachan Exp $
#

use vars qw($debug);
use vars qw($Rcsid $URLComInfo);
use vars qw(%RelayRcpt);  # special recipient forwarded to specified relay
use vars qw($SUN_OS_413); # obsolete but defined for compatibility 
use vars qw($SENDFILE_NO_FILECHECK); # obsolete

# NEW VERSION FOR MULTIPLE @to and @files (required @files NOT $files) 
# return NONE
sub DoNeonSendFile
{
    local(*to, *subject, *files) = @_;
    local($le, %le, @rcpt, $f, @f, %f);
    my (@info) = caller;
    my ($n, $error);

    # backward compat;
    $SENDFILE_NO_FILECHECK = 1 if $SUN_OS_413;

    ### DEBUG INFO;
    &Debug("NeonSendFile[@info]:\n\nSUBJECT\t$subject\nFILES:\t") if $debug;
    &Debug(join(" ", @files)) if $debug;

    ### check again $file existence
    for $f (@files) {
	next if $f =~ /^\s*$/;
	$n = $f; $n =~ s#^/*$DIR/##;

	if (-f $f) {		# O.K. anyway exists!
	    push(@f, $f);	# store it as a candidate;

	    # Anyway copy each entry of each subject(%files) to %f
	    $f{$f, 'subject'} = $files{$f, 'subject'} if $files{$f, 'subject'};

	    next if $SENDFILE_NO_FILECHECK; # Anytime O.K. if no checked;

	    # Check whether JIS or not
	    if (-z $f) {
		&Log("NeonSendFile::Error $n is 0 bytes");
	    }
	    elsif (-B $f) {
		&Log("NeonSendFile::Error $n is not JIS");

		# AUTO CONVERSION 
		eval "require 'jcode.pl';";
		unless ($@) {
		    &Log("NeonSendFile::AutoConv $n to JIS");
		    $f{$f, 'autoconv'} = 1;
		}
	    }

	    # misc checks
	    &Log("NeonSendFile: cannot read $n") if !-r $f;
	}
	### NOT EXISTS 
	else {
	    &Log("NeonSendFile: $n is not found.", "[ @info ]");
	    $f =~ s/$DIR/\$DIR/;
	    $error .= &Translate(*Envelope, 
				 "$f is not found.",
				 'not_found', $f);
	    $error .= "\n[ @info ]\n\n";
	    &Log("ERROR: NeonSendFile: $f is not found");
	    &Mesg(*Envelope, "$f is not found.", 'not_found', $f);
	}

	$error && &Warn("ERROR NeonSendFile", $error);
	return $NULL if $error;	# END if only one error is found. Valid?
    } # for loop;

    ### DEFAULT SUBJECT. ABOVE, each subject for each file 
    $le{'GH:Subject:'} = $subject;
    $le{'preamble'} .= $Envelope{'preamble'}.$PREAMBLE_MAILBODY;
    $le{'trailer'}  .= $Envelope{'trailer'}.$TRAILER_MAILBODY;

    &GenerateHeader(*to, *le, *rcpt);

    $le = &Smtp(*le, *rcpt, *f);
    &Log("NeonSendFile:$le") if $le;
}


#
# SendFile is just an interface of Sendmail to send a file.
# Mainly send a "PLAINTEXT" back to @to, that is a small file.
# require $zcat = non-nil and ZCAT is set.
sub DoSendFile
{
    local(@to, %le, @rcpt, @files, %files);
    local($to, $subject, $file, $zcat, @to) = @_;

    @to || push(@to, $to); # extention for GenerateHeader

    # (before it, checks whether the return address is not ML nor ML-Ctl)
    if (! &CheckAddr2Reply(*Envelope, $to, @to)) { return;}

    push(@files, $file);
    (1 == $zcat) && ($files{$f, 'zcat'} = 1);
    (2 == $zcat) && ($files{$f, 'uuencode'} = 1);

    &DoNeonSendFile(*to, *subject, *files); #(*to, *subject, *files);
}

# Interface for sending plural files;
sub DoSendPluralFiles
{
    local(*to, *subject, *files) = @_;
    if (! &CheckAddr2Reply(*Envelope, $to, @to)) { return;}
    &DoNeonSendFile(*to, *subject, *files);
}

# Sendmail is an interface of Smtp, and accept strings as a mailbody.
# Sendmail($to, $subject, $MailBody) paramters are only three.
sub DoSendmail
{
    local(@to, %le, @rcpt);
    my ($xto, $subject, $body, @xto) = @_;
    push(@to, @xto);
    push(@to, $xto); # extention for GenerateHeader

    # (before it, checks whether the return address is not ML nor ML-Ctl)
    if (! &CheckAddr2Reply(*Envelope, $xto, @to)) { return;}

    $le{'GH:Subject:'} = $subject;
    &GenerateHeader(*to, *le, *rcpt);
    
    $le{'preamble'} .= $Envelope{'preamble'}.$PREAMBLE_MAILBODY;
    $le{'Body'}     .= $body;
    $le{'trailer'}  .= $Envelope{'trailer'}.$TRAILER_MAILBODY;

    $le = &Smtp(*le, *rcpt);
    &Log("Sendmail:$le") if $le;
}


sub DoSendmail2
{
    local(*distfile, $subject, $body) = @_;

    if (-f $distfile && open(DIST, $distfile)) {
	my (@a, $a);
	while (<DIST>) {
	    next if /^\s*$/;
	    next if /^\#/;

	    ($a) =split(/\s+/, $_);
	    push(@a, $a);
	}
	close(DIST);

	$a = shift @a; # Hmm... tricky and dirty ;D
	&DoSendmail($a, $subject, $body, @a);
    }
    else {
	&Log("cannot open $distfile");
	0;
    }
}

# SendFile2(*to, *subject, *files);
sub DoSendFile2 { &DoNeonSendFile(@_);}

# SendFile2(*distfile, *subject, *files);
# import $misc{'hook'}
sub DoSendFile3
{
    local(*distfile, *subject, *files, *misc) = @_;
    local(@to, $to, @f2s);

    $REPORT_HEADER_CONFIG_HOOK = qq#;
    $misc{'hook'};
    \$le{'mode:delivery:list'} = \"$distfile\";
    #;

    @to = ($MAINTAINER); # dummy
    push(@f2s, $files);
    push(@f2s, @files);
    &DoNeonSendFile(*to, *subject, *f2s);
}


# Generating Headers, and SMTP array
sub GenerateMail    { &DoGenerateHeaders(@_);}
sub GenerateHeaders { &DoGenerateHeader(@_);}
sub DoGenerateHeader
{
    # old format == local(*to, $subject) 
    # @Rcpt is passed as "@to" even if @to has one addr;
    # WE SHOULD NOT TOUCH "$to" HERE;
    local(*to, *le, *rcpt) = @_;
    my ($tmpto, %dup);

    # Resent (RFC822)
    @ResentHdrFieldsOrder = ("Resent-Reply-To", "Resent-From", "Resent-Sender",
			     "Resent-Date", 
			     "Resent-To", "Resent-Cc", "Resent-Bcc", 
			     "Resent-Message-Id");

    # @to is required; but we can make $from appropriatedly;
    @to || do { &Log("GenerateHeader: ERROR: NO \@to"); return;};

    # prepare: *rcpt for Smtp();
    my ($lc_rcpt);
    for (@to) {
	# Address Representation Range Check
	&ValidAddrSpecP($_) || /^[^\@]+$/ || do {
	    &Log("GenerateHeaders: <$_> is invalid");
	    next;
	};

	push(@rcpt, $_); # &Smtp(*le, *rcpt);
	$tmpto .= $tmpto ? ", $_" : $_; # a, b, c format

	# always relay
	if ($DEFAULT_RELAY_SERVER) {
	    $lc_rcpt = $_;
	    $lc_rcpt =~ tr/A-Z/a-z/; # lower case;
	    $RelayRcpt{$lc_rcpt} = "\@${DEFAULT_RELAY_SERVER}:$_";
	}
    }

    $Rcsid  =~ s/\)\(/,/g;

    # fix *le(local) by *Envelope(global)
    $le{'macro:s'}    = $Envelope{'macro:s'};
    $le{'mci:mailer'} = $Envelope{'mci:mailer'};

    my $m = $HAS_GETPWUID ? (getpwuid($<))[0] : 
	($ENV{'USER '}|| $ENV{'USERNAME'});

    $le{'GH:From:'}        = $MAINTAINER || "$m\@$DOMAINNAME";
    $le{'GH:To:'}          = $tmpto;
    $le{'GH:Date:'}        = $MailDate;
    $le{'GH:References:'}  = $Envelope{'h:message-id:'};
    $le{'GH:References:'}  =~ s/^\s+//;
    $le{'GH:X-MLServer:'}  = $Rcsid;
    $le{'GH:X-ML-Info:'}   = $URLComInfo if $URLComInfo;
    $le{'GH:From:'}       .= " ($MAINTAINER_SIGNATURE)"
	if $MAINTAINER_SIGNATURE;

    $le{'GH:Message-Id:'}  = &GenMessageId;

    if ($LANGUAGE eq 'Japanese') {
	$le{'GH:Mime-Version:'} = '1.0';
	$le{'GH:Content-Type:'} = 'text/plain; charset=iso-2022-jp';
    }
	
    # Run-Hooks. when you require to change header fields...
    if ($REPORT_HEADER_CONFIG_HOOK) {
	&eval($REPORT_HEADER_CONFIG_HOOK, 'REPORT_HEADER_CONFIG_HOOK');
    }

    # MEMO:
    # MIME (see RFC1521)
    # $_PCB{'header', 'MIME'} => $Envelope{'GH:MIME:'}
    # 
    if (@ResentForwHdrFieldsOrder) { 
	for (@ResentForwHdrFieldsOrder, @ResentHdrFieldsOrder) {
	    &Debug("DUP FIELD\t$_") if $dup{$_} && $debug;
	    next if $dup{$_}; $dup{$_} = 1; # duplicate check;

	    if ($Envelope{"GH:$_:"} || $le{"GH:$_:"}) {
		$le{'Hdr'} .= "$_: ".($Envelope{"GH:$_:"}||$le{"GH:$_:"})."\n";
	    }
	}
    }
    else {
	for (@HdrFieldsOrder, @ResentHdrFieldsOrder) {
	    &Debug("DUP FIELD\t$_") if $dup{$_} && $debug;
	    next if $dup{$_}; $dup{$_} = 1; # duplicate check;

	    if ($Envelope{"GH:$_:"} || $le{"GH:$_:"}) {
		$le{'Hdr'} .= "$_: ".($Envelope{"GH:$_:"}||$le{"GH:$_:"})."\n";
	    }
	}
    }
}


1;
### ---end of including 


### ---including #.include proc/libkern.pl

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


##### SubRoutines #####

####### Section: Main Mode Bifurcation

# NOT $Envelope{'mode:ctladdr'} IS IMPORTANT;
# mode:ctladdr >> mode:distribute, mode:distribute*
# Changed a lot at 2.1 DELTA
sub ModeBifurcate
{
    local($command_mode, $member_p, $compat_hml); 

    # Do nothing. Tricky. Please ignore 
    if ($DO_NOTHING) { return 0;}

    # DataBase Access Probe()
    # return ASAP if database server is inaccessible.
    if ($USE_DATABASE) {
	&use('databases');

	# try to probe server
	my (%mib, %result, %misc, $error);
	&DataBaseMIBPrepare(\%mib, 'member_p', {'address' => $From_address});
	&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
	if ($mib{'error'}) {
	    &Mesg(*Envelope, 'database error occurs', 'configuration_error');
	    return 0; # return ASAP
	}
    }

    # member ot not?
    &AdjustActiveAndMemberLists;
    $member_p = &MailListMemberP($From_address);
    $member_p = 1 if $Envelope{"trap:+"};
    $Envelope{'mode:stranger'} = 1 unless $member_p;

    # chaddr is available from new address if old to "chaddr" is a member;
    # hml compatible case (not default)
    if (!$member_p && $Envelope{'mode:uip:chaddr'}) {
	&use('utils');
	if (&ChAddrModeOK($Envelope{'mode:uip:chaddr'})) {
	    $Envelope{'mode:uip'} = $member_p = 1;
	}
    }
    # hml compatible case (not default)
    elsif ($CHADDR_AUTH_TYPE eq 'confirmation' && 
	   $Envelope{'mode:uip:chaddr-confirm'}) {
	$Envelope{'mode:uip'} = 1;
    }

    # fml 0.x - fml 2.1gamma compat (not default)
    $compat_hml = &CompatFMLv1P;

    # default
    $REJECT_POST_HANDLER    = $REJECT_POST_HANDLER    || 'Reject';
    $REJECT_COMMAND_HANDLER = $REJECT_COMMAND_HANDLER || 'Reject';

    %RejectHandler = ("reject",      "RejectHandler",
		      "auto_regist", "AutoRegistHandler",
		      "autoregist",  "AutoRegistHandler",
		      "ignore",      "IgnoreHandler",

		      "auto_subscribe", "AutoRegistHandler",
		      "auto_asymmetric_regist", "AutoRegistHandler",
		      );
    if ($debug) {
	&Log("ModeBifurcate: \$PERMIT_POST_FROM    $PERMIT_POST_FROM");
	&Log("ModeBifurcate: \$PERMIT_COMMAND_FROM $PERMIT_COMMAND_FROM");
	&Log("ModeBifurcate: artype   $AUTO_REGISTRATION_TYPE");
	&Log("ModeBifurcate: key      $AUTO_REGISTRATION_KEYWORD");
	&Log("ModeBifurcate: member_p $member_p");
    }

    ### 00.01 Run Hooks 
    if ($MODE_BIFURCATE_HOOK) {
	&eval($MODE_BIFURCATE_HOOK, "MODE_BIFURCATE_HOOK");
    }

    ### 01: compat_hml mode
    if ($compat_hml) {
	&Log("compat_hml mode") if $debug;

	if (!$Envelope{"compat:cf2:post_directive"} &&
	    ($Envelope{'mode:req:guide'} || $Envelope{'req:guide'})) {
	    &GuideRequest(*Envelope);	# Guide Request from anyone
	    return;	# end;
	}

	local($ca) = &CutFQDN($CONTROL_ADDRESS);
	# Default LOAD_LIBRARY SHOULD NOT BE OVERWRITTEN!
	if ($Envelope{'mode:uip'} && 
	    ($Envelope{'trap:rcpt_fields'} =~ /$ca/i)) {
	    $command_mode = 1;
	}
    } 


    ### 02: determine command mode or not
    if ($Envelope{'mode:ctladdr'} || $COMMAND_ONLY_SERVER) {
	&Log("\$command_mode = 1;") if $debug;
	$command_mode = 1;
    }
    # BACKWARD COMPATIBLE 
    # when trap the mail body's "# command" syntax but without --ctladdr
    # at this switch already "!$Envelope{'mode:ctladdr'}" is true
    # but post=* is exception
    elsif ($compat_hml && $Envelope{'mode:uip'}) {
	&Log("backward && uip => command_mode on") if $debug;
	$command_mode = 1;
    }

    # post=* mode and !"ctladdr mode" disables commands
    if (!$Envelope{"mode:ctladdr"} && 
	$Envelope{"compat:cf2:post_directive"}) { 
	&Log("02 undef \$command_mode = $command_mode;") if $debug;
	undef $command_mode;
    }

    &Log("03 \$command_mode = $command_mode;") if $debug;

    # initialize Information
    &GenInfo;

    ### 03: Bifurcate by Condition
    # Do nothing. Tricky. Please ignore 
    if ($DO_NOTHING) {
	return 0;	
    }
    # command mode?
    elsif ($command_mode) {
	$Envelope{'pcb:mode'} = 'command'; # process control block

	# NOT PERMIT COMMAND WHEN MAIL SIZE IS OVER LIMIT.
	if ($Envelope{'trap:mail_size_overflow'}) {
	    &Log("ModeBifurcate: ignore too bit mail in command mode");
	    return $NULL;
	}

	
        if ($PERMIT_COMMAND_FROM eq "anyone") {
	    require($LOAD_LIBRARY = $LOAD_LIBRARY || 'libfml.pl');
	    &Command() if $ForceKickOffCommand;
	}
	elsif ($PERMIT_COMMAND_FROM eq "members_only" ||
	       $PERMIT_COMMAND_FROM eq "members"
	       ) {
	    if ($member_p) {
		if ($Envelope{'mode:req:unsubscribe-confirm'}) {
		    undef $LOAD_LIBRARY;
		    require 'libfml.pl';
		    &Command($Envelope{'buf:req:unsubscribe-confirm'});
		}
		else {
		    require($LOAD_LIBRARY = $LOAD_LIBRARY || 'libfml.pl');
		    &Command() if $ForceKickOffCommand;
		}
	    }
	    # not member and ignore the mail
	    elsif ((! $member_p) && ($REJECT_COMMAND_HANDLER eq "ignore")) {
		&Log("ignore request from not member");
	    }
	    # chaddr-confirm
	    elsif ((! $member_p) && $Envelope{'mode:req:chaddr-confirm'}) {
		&use('trap');
		&Trap__ChaddrConfirm(*Envelope);
	    }
	    # chaddr
	    elsif ((! $member_p) && $Envelope{'mode:req:chaddr'}) {
		&use('trap');
		&Trap__ChaddrRequest(*Envelope);
	    }
	    # we should return reply for "guide" request from even "stranger";
	    elsif ((! $member_p) &&
		   ($Envelope{'mode:req:guide'} || $Envelope{'req:guide'})) {
		&GuideRequest(*Envelope);
	    }
	    # MANUAL REGISTRATION REQUEST WITH CONFIRMATION (subscribe)
	    elsif ((! $member_p) && $Envelope{'mode:req:subscribe'} &&
		   &NonAutoRegistrableP) {
		&Log("manual subscribe request");
		&use('confirm');
		
		&ManualRegistConfirm(*Envelope, 'subscribe',
				     $Envelope{'buf:req:subscribe'});
	    }
	    # MANUAL REGISTRATION REQUEST WITH CONFIRMATION (confirm)
	    elsif ((! $member_p) && $Envelope{'mode:req:confirm'} &&
		   &NonAutoRegistrableP) {
		&Log("manual subscribe confirmed");
		&use('confirm');
		&ManualRegistConfirm(*Envelope, 'confirm',
				     $Envelope{'buf:req:confirm'});
	    }
	    else {
		$fp = $RejectHandler{$REJECT_COMMAND_HANDLER}||"RejectHandler";
		&$fp(*Envelope);
	    }
	}
	elsif ($PERMIT_COMMAND_FROM eq "moderator") { # dummay ?
	    &use('moderated');
	    $Envelope{'mode:moderator:command'} = 1;
	    &ModeratedDelivery(*Envelope); # Moderated: check Approval;
	}
	else {
	    &Log("ERROR: \$PERMIT_COMMAND_FROM is unknown type.");
	}
    }
    # distribute
    else {
	$Envelope{'pcb:mode'} = 'distribute'; # process control block

        if ($PERMIT_POST_FROM eq "anyone") {
	    &Distribute(*Envelope, 'permit from anyone');
	}
	elsif ($PERMIT_POST_FROM eq "members_only" ||
	       $PERMIT_POST_FROM eq "members"
	       ) {
	    if ($member_p) {
		&Distribute(*Envelope, 'permit from members_only');
	    }
	    else {
		$fp = $RejectHandler{$REJECT_POST_HANDLER}||"RejectHandler";
		&$fp(*Envelope);
	    }
	}
	elsif ($PERMIT_POST_FROM eq "moderator") {
	    &use('moderated');
	    &ModeratedDelivery(*Envelope); # Moderated: check Approval;
	}
	else {
	    &Log("ERROR: \$PERMIT_POST_FROM is unknown type.");
	}

	# to ensure the unique Date: (since the smallest unit is second).
	if ($DATE_TYPE =~ /distribute-date/) { sleep 1;}
    }

    &LogFileNewSyslog if $LOGFILE_NEWSYSLOG_LIMIT; # log file turn over
}

####### Section: Main Functions
#
# Configuration Files: evalucation order
#
# 1 site_init      site default
# 2 <ML>/config.ph each ML configurations
# 3 sitedef        force site-own-rules to overwrite ML configrations 
#
sub LoadConfig
{
    # configuration file for each ML
    if (-e "$DIR/config.ph" && ((stat("$DIR/config.ph"))[4] != $<)) { 
	print STDERR "\nFYI: include's owner != config.ph's owner, O.K.?\n\n";
    }

    # 3.0B new loading configuration
    # XXX &__LoadConfiguration('__KERN__'); for main routine: fml.pl, libkern
    # XXX &__LoadConfiguration;             for other tools: bin/* ...
    require 'libloadconfig.pl'; &__LoadConfiguration('__KERN__');

    require 'libsmtp.pl';		# a library using smtp

    # load MIME handling functions for convenience
    if ($LANGUAGE eq 'Japanese') { require 'libMIME.pl';}

    # if mode:some is set, load the default configuration of the mode
    for (keys %Envelope) { 
	/^mode:(\S+)/ && $Envelope{$_} && do { &DEFINE_MODE($1);};
    }
}

sub SetDefaults
{
    $NULL                   = '';    # useful constant :D
    $Envelope{'mci:mailer'} = 'ipc'; # use IPC(default)
    $Envelope{'mode:uip'}   = '';    # default UserInterfaceProgram is nil.;
    $Envelope{'mode:req:guide'} = 0; # not member && guide request only

    $MyProcessInfo = "$$ $DIR";      # ps shows this as a part of argv[0]

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

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

    # Architecture Dependence;
    $UNISTD = $HAS_ALARM = $HAS_GETPWUID = $HAS_GETPWGID = $HAS_GETGRENT = 1;
    
    # REQUIRED AS DEFAULTS
    %SEVERE_ADDR_CHECK_DOMAINS = ('or.jp', +1, 'ne.jp', +1);
    $REJECT_ADDR  = 'root|postmaster|MAILER-DAEMON|msgs|nobody';
    $REJECT_ADDR .= '|majordomo|listserv|listproc';
    $REJECT_ADDR .= '|\S+\-subscribe|\S+\-unsubscribe|\S+\-help';
    $SKIP_FIELDS  = 'Received|Return-Receipt-To';
    $ADD_URL_INFO = $ML_MEMBER_CHECK = $CHECK_MESSAGE_ID = $USE_FLOCK = 1;
    $NOTIFY_MAIL_SIZE_OVERFLOW = 1;
    $CHADDR_CONFIRMATION_KEYWORD = 'chaddr-confirm';
    $UNSUBSCRIBE_CONFIRMATION_KEYWORD = 'unsubscribe-confirm';

    # Envelope Filter
    $FILTER_ATTR_REJECT_NULL_BODY = $FILTER_ATTR_REJECT_ONE_LINE_BODY = 1;
    $FILTER_ATTR_REJECT_INVALID_COMMAND = 1;

    ### default distribution and command mode
    $PERMIT_POST_FROM    = $PERMIT_COMMAND_FROM    = "members_only";
    $REJECT_POST_HANDLER = $REJECT_COMMAND_HANDLER = "reject";

    ### fmlserv compat code; (e.g. a bit for umask and permissions ctrl)
    if (-d "$DIR/../fmlserv") { # tricky ;-)
	$USE_FML_WITH_FMLSERV = 1; 
	$GID = (stat("$DIR/../fmlserv"))[5];
    }

    ### Security; default security level (mainly backward compat)
    undef %Permit;

    @DenyProcedure = ('library');
    @HdrFieldsOrder =	# rfc822; fields = ...; Resent-* are ignored;
	('Return-Path', 'Received',
	 'Delivered-To',  # for postfix, qmail
	 'Date', 'Posted', 'X-Posted', 'X-Original-Date',
	 'From', 'Reply-To', 'Subject', 'Sender', 
	 'To', 'Cc', 'Errors-To', 'Message-Id', 'In-Reply-To', 
	 'References', 'Keywords', 'Comments', 'Encrypted',
	 ':XMLNAME:', ':XMLCOUNT:', 'X-MLServer', 
	 'XRef', 'X-Stardate', 'X-ML-Info', 
	 'X-Mailer', 'X-Dispatcher', 'X-Newsreader', 'User-Agent',
	 'Mail-Followup-To',	# I-D now?
	 ':body:', ':any:', 
	 'X-Authentication-Warning',
	 'Mime-Version', 'Content-Type', 'Content-Transfer-Encoding',
	 'Content-ID', 'Content-Description', # RFC2045
	 'Precedence', 'Lines');
    
    # Content Filtering Handler for MIME
    @MailContentHandler = ();	# Default: No filter
}

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

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

sub InitConfig
{
    # XXX SetDefaults but works after &__LoadConfiguration, so defined here.
    # 3.0.1 compatible with 3.0's "From: $MAIL_LIST" rejection
    # disabled by fukachan (2000/06/19), PR8220 pointed out by MURASHITA Takuya
    # &DEFINE_FIELD_LOOP_CHECKED('from');

    # $FML for process table readability
    eval q{ use File::Basename;};
    unless ($@) {
	$ExecDir = dirname($0);
	$FML     = basename($0);
    }
    else {
	if ($0 =~ m%^(.*)/(.*)%) { $ExecDir = $1; $FML = $2;}
    }

    # fml 4.0 modules
    unshift(@INC, "$ExecDir/module/fml-devel");
    unshift(@INC, "$ExecDir/module/CPAN");
    unshift(@INC, "$ExecDir/module/Jcode");
    unshift(@INC, "$ExecDir/module/Japanese");
    unshift(@INC, "$ExecDir/module");
    unshift(@INC, $LIBDIR) if $LIBDIR;
    unshift(@INC, $DIR);

    &SetDefaults;
    &LoadConfig;

    # a little configuration before the action
    if (defined $FML_UMASK) {
	$UMASK = $FML_UMASK;
    }
    elsif (defined $UMASK) {
	;
    }
    elsif ($USE_FML_WITH_FMLSERV) {
	$UMASK = 007; # rw-rw----
    }
    else {
	$UMASK = 077; # rw-------
    }

    umask($UMASK);
    defined $DEFAULT_DIR_MODE || ($DEFAULT_DIR_MODE = ($UMASK & 0777) ^ 0777);

    ### Against the future loop possibility
    if (&AddressMatch($MAIL_LIST, $MAINTAINER)) {
	&Log("DANGER! \$MAIL_LIST == \$MAINTAINER, STOP!");
	exit 0;
    }

    # set architechture if not defined
    if (! $COMPA_ARCH) {
	if ($CPU_TYPE_MANUFACTURER_OS =~ /(sysv4|solaris2)/i) {
	    $COMPAT_ARCH = "SOLARIS2";
	}
	elsif ($CPU_TYPE_MANUFACTURER_OS =~ /windowsnt4$/i) {
	    $COMPAT_ARCH = "WINDOWS_NT4";
	}
    }

    ### Options
    &SetOpts;

    # load architecture dependent default 
    # here for command line options --COMPAT_ARCH
    if ($COMPAT_ARCH)  { require "sys/$COMPAT_ARCH/depend.pl";}

    if ($DUMPVAR) { require 'dumpvar.pl'; &dumpvar('main');}
    if ($debug)   { require 'libdebug.pl';}
    if ($Opt{"opt:b"} eq 'd') { &use('utils'); &daemon;} # become daemon;

    # COMPATIBILITY
    if ($COMPAT_CF1 || ($CFVersion < 2))   { &use('compat_cf1');}
    if ($CFVersion < 3) { &use('compat_cf2');}
    if ($COMPAT_FML15) { &use('compat_cf1'); &use('compat_fml15');}
    if (!$TZone) { $TZone = '+0900';} # TIME ZONE

    &GetTime;			        # Time, (may be for compatible codes)

    push(@MAIL_LIST_ALIASES, @PLAY_TO);
    unshift(@ARCHIVE_DIR, $ARCHIVE_DIR);

    ### Initialize DIR's and FILE's of the ML server
    # FullPath-ed (FP)
    local($s);
    for (SPOOL_DIR,TMP_DIR,VAR_DIR,VARLOG_DIR,VARRUN_DIR,VARDB_DIR) {
	&eval("\$s = \$$_; \$s =~ s#\$DIR/##g; \$s =~ s#$DIR/##g;");
	&eval("\$FP_$_ = \"$DIR/\$s\";");
	&eval("\$$_ =~ s#\$DIR/##g; \$$_ =~ s#\$DIR/##g;");
	&eval("-d \$$_||&Mkdir(\$$_);");
    }

    if ($USE_DATABASE) {
	for ($LOGFILE, $MGET_LOGFILE, 
	     $SEQUENCE_FILE, $SUMMARY_FILE, $LOG_MESSAGE_ID) {
	    -f $_ || &Touch($_);
	}	
    }
    else {
	for ($LOGFILE, $MEMBER_LIST, $MGET_LOGFILE, 
	     $SEQUENCE_FILE, $SUMMARY_FILE, $LOG_MESSAGE_ID) {
	    -f $_ || &Touch($_);
	}	
    }

    ### CFVersion 3
    ### DEFINE INTERNAL FLAG FOR THE USE $DIR/members or $DIR/actives ?
    ### $ML_MEMBER_CHECK is internal variable to indicate file relation
    local($touch) = "${ACTIVE_LIST}_is_dummy_when_auto_regist";
    if (&AutoRegistrableP) {
	$ML_MEMBER_CHECK = 0;	# backward
	if (&NotUseSeparateListP) {
	    &Touch($touch) if ! -f $touch;
	}
	else {
	    unlink $touch if -f $touch;
	}
    }
    else {
	-f $ACTIVE_LIST || &Touch($ACTIVE_LIST);
	unlink $touch if -f $touch;
    }

    if ($SUBJECT_TAG_TYPE) { 
	&use("tagdef");
	&SubjectTagDef($SUBJECT_TAG_TYPE);
    }
    ### END CFVersion 3

    ### misc 
    $LOG_MESSAGE_ID = $LOG_MESSAGE_ID || "$VARRUN_DIR/msgidcache";#important;
    $LOG_MAILBODY_CKSUM = $LOG_MAILBODY_CKSUM || "$VARRUN_DIR/bodycksumcache";
    $REJECT_ADDR_LIST = $REJECT_ADDR_LIST || "$DIR/spamlist";
    $FML .= "[".(split(/\@/, $MAIL_LIST))[0]."]"; # For tracing Process Table

    # initialize some arrays; if auto-regist is clear here, we reset;
    &AdjustActiveAndMemberLists;
    
    # since variables are defined in config.ph;
    @NEWSYSLOG_FILES =	@NEWSYSLOG_FILES ||
	("$MSEND_RC.bak", "$MEMBER_LIST.bak", "$ACTIVE_LIST.bak");

    # struct sockaddr { ;}
    $STRUCT_SOCKADDR = $STRUCT_SOCKADDR || "S n a4 x8";
    
    # &BackwardCompat;
    &DEFINE_MODE('expire')  if $USE_EXPIRE;  # 2.1 release built-in expire
    &DEFINE_MODE('archive') if $USE_ARCHIVE; # 2.1 release built-in archive;
    &DEFINE_MODE('html')    if $AUTO_HTML_GEN;

    # command trap keywrod : '# ' ; in default, we not use it.
    # XXX: "# command" is internal represention
    # XXX: it is historical, so remove '# command' part if exist and possible.
    $Envelope{'trap:ctk'} = &CompatFMLv1P ? '# ' : '';
    
    # signal handling
    $SIG{'ALRM'} = 'Tick';
    $SIG{'INT'}  = $SIG{'QUIT'} = $SIG{'TERM'} = 'SignalLog';
    
    # MIME Content Handler(include backword compatible)
    if ($AGAINST_HTML_MAIL ||
	$HTML_MAIL_DEFAULT_HANDLER eq 'strip') {
	&ADD_CONTENT_HANDLER('multipart/.*', 'text/plain', 'allow');
	&ADD_CONTENT_HANDLER('multipart/.*', '.*/.*',      'strip');
	&ADD_CONTENT_HANDLER('text/plain',   '.*/.*',      'allow');
	&ADD_CONTENT_HANDLER('!MIME',        '.*/.*',      'allow');
    } elsif ($HTML_MAIL_DEFAULT_HANDLER eq 'reject') {
	&ADD_CONTENT_HANDLER('multipart/.*', 'text/plain', 'allow');
	&ADD_CONTENT_HANDLER('multipart/.*', '.*/.*',      'reject');
	&ADD_CONTENT_HANDLER('text/plain',   '.*/.*',      'allow');
	&ADD_CONTENT_HANDLER('!MIME',        '.*/.*',      'allow');
    }

    # For example, $LOGFILE_SUFFIX = ".%C%y";
    if ($LOGFILE_SUFFIX) {
	use POSIX;
	$LOGFILE .= strftime($LOGFILE_SUFFIX, localtime(time));
    }
}

# one pass to cut out the header and the body
sub Parsing { &Parse;}
sub Parse
{
    $0 = "${FML}: Parsing header and body <$MyProcessInfo>";
    local($bufsiz, $buf, $p, $maxbufsiz, $in_header);

    $maxbufsiz = &ATOI($INCOMING_MAIL_SIZE_LIMIT) if $INCOMING_MAIL_SIZE_LIMIT;

    undef $Envelope{'Body'};
    $in_header = 1; # firstly header comes.
    while ($p = sysread(STDIN, $_, 1024)) {
	$bufsiz += $p; 

	if ($INCOMING_MAIL_SIZE_LIMIT && ($bufsiz > $maxbufsiz)) {
	    $Envelope{'trap:mail_size_overflow'} = 1;
	    last;
	}

	$Envelope{'Body'} .= $_;

	if ($in_header) {
	    # separator between header and body is found!
	    if (($p = index($Envelope{'Body'}, "\n\n", 0)) > 0) {
		$Envelope{'Header'} = substr($Envelope{'Body'}, 0, $p + 1);
		$Envelope{'Body'}   = substr($Envelope{'Body'}, $p + 2);
		$in_header = 0;
	    }
	}
    }

    # oops, header only mail ?! (2000/05/31 by fukachan)
    if ($in_header) {
	$Envelope{'Header'} = $Envelope{'Body'};
	undef $Envelope{'Body'};
    }

    # Really? but check "what happen if no input is given?".
    if ($bufsiz == 0) {
	&Log("read 0 bytes, stop");
	exit(0);
    }
    $Envelope{'tmp:bufsiz'} = $bufsiz;

    # hold size info at process control block
    $Envelope{ _pcb }->{ incoming_message }->{ total_read_size } = $bufsiz;
}

# Phase 2 extract several fields 
sub GetFieldsFromHeader
{
    local($field, $value, @hdr, %hf);
    local($s);

    $0 = "${FML}: GetFieldsFromHeader <$MyProcessInfo>";

    # To ensure non exsistence
    for (split(/\|/, $SKIP_FIELDS)) { &DELETE_FIELD($_);}

    # pass all fields through
    if ($SUPERFLUOUS_HEADERS || $PASS_ALL_FIELDS_IN_HEADER) { 
	$hdr_entry = join("|", @HdrFieldsOrder);
    }

    ### Header Fields Extraction
    $s = $Envelope{'Header'}."\n";
    if ($s =~ /^From\s+(\S+)/i) {
	# XXX NO REACH HERE (1999/10/27 by fukachan)
	# $Envelope{'UnixFrom'} = $UnixFrom = $1;
	$s =~ s/^From\s+.*//i;
    }

    $s = "\n".$s;		# tricky
    if ($ALLOW_WRONG_LINES_IN_HEADER){
	$s =~ s/(?<=\n)(?=:|[^\s:]+\s)/X-Wrong-Lines: /sg;
    }
    $s =~ s/\n(\S+?):/\n\n$1:\n\n/g; #  trick for folding and unfolding.
    $s =~ s/^\n*//;		# remove the first null lines;

    @hdr = split(/\n\n/, $s);
    while (@hdr) {
	$_ = $field = shift @hdr;
	last if /^[\s\n]*$/;	# null field must be end
	$value = shift @hdr;	# not cut the first spaces of $value

	print STDERR "FIELD>$field<\n     >$value<\n" if $debug;

	# Save Entry anyway. '.=' for multiple 'Received:'
	$field =~ tr/A-Z/a-z/;
	$hf{$field} = 1;
	$Envelope{$field} .= $Envelope{$field} ? "\n${_}$value" : $value;

	# e.g. ONLY multiple Received: are possible.
	# "Cc: ..\n Cc: ..\n" also may exist
	$Envelope{"h:$field"} .= 
	    $Envelope{"h:$field"} ? "\n${_}$value" : $value;

	next if /^($SKIP_FIELDS):/i;

	# hold fields without in use_fields if $SUPERFLUOUS_HEADERS is 1.
	if ($SUPERFLUOUS_HEADERS || $PASS_ALL_FIELDS_IN_HEADER) {
	    next if /^($hdr_entry)/i; # :\w+: not match
	    $Envelope{'Hdr2add'} .= "${_}$value\n";
	}
    }

    ### Anyway set all the fields (96/09/24) ###
    local($f, $fc, $k, $v, $x);
    while (($k, $v) = each %hf) {
	$_ = &FieldCapitalize($k);
 	$Envelope{"h:$_"} = $Envelope{"h:$k"};
    }

    ### fix Unix From
    if (! $Envelope{'UnixFrom'}) { # == !$UnixFrom
	$UnixFrom = $Envelope{'h:return-path:'} || $Envelope{'h:From:'} ||
	    "postmaster\@$FQDN";
	$UnixFrom = $Unix_From = $Envelope{'UnixFrom'} = 
	    &Conv2mailbox($UnixFrom, *Envelope);
    }
}

# LATTER PART is to fix extracts
# Set variables to need special effects 
sub FixHeaderFields
{
    local(*e) = @_;
    local($addr);

    ### MIME: IF USE_LIBMIME && MIME-detected;
    if ($USE_MIME && $e{'Header'} =~ /=\?ISO\-2022\-JP\?/io) {
	$e{'MIME'}= 1;
    }

    ### $MAIL_LIST Aliases 
    $addr = "$e{'h:recent-to:'}, $e{'h:to:'}. $e{'h:cc:'}";
    for (@MAIL_LIST_ALIASES) {
	next unless $_;
        if ($addr =~ /$_/i) { $MAIL_LIST = $_;}
    }

    $e{'h:Return-Path:'} = "<$MAINTAINER>";        # needed?
    $e{'h:Precedence:'}  = $PRECEDENCE || 'list';
    # $e{'h:Lines:'}     = $e{'nlines'}; now in CheckCurrentProc (97/12/07)

    # Date: field type definition
    if ($DATE_TYPE eq 'original-date') {
	$e{'h:Date:'} = $e{'h:date:'};
    }
    elsif ($DATE_TYPE eq 'received-date+x-posted') {
	$e{'h:Date:'}     = $MailDate;
	$e{'h:X-Posted:'} = $e{'h:date:'} || $e{'h:Date:'};
    }
    elsif ($DATE_TYPE eq 'received-date+x-original-date') {
	$e{'h:Date:'}     = $MailDate;
	$e{'h:X-Original-Date:'} = $e{'h:date:'} || $e{'h:Date:'};
    }
    elsif (($DATE_TYPE eq 'received-date') ||
	   ($DATE_TYPE eq 'received-date+posted') ||
	   (!$DATE_TYPE)) { # default (backward)
	$e{'h:Date:'}   = $MailDate;
	$e{'h:Posted:'} = $e{'h:date:'} || $e{'h:Date:'};
    }

    # Some Fields need to "Extract the user@domain part"
    # Addr2Reply: is used to pass to sendmail as the recipient
    $From_address        = &Conv2mailbox($e{'h:from:'}, *e);
    $e{'macro:x'}        = $e{'tmp:x'}; 
    &Log("Gecos [$e{'macro:x'}]") if $debug;

    # XXX should we nuke $COMMAND_RETURN_ADDR_POLICY ?
    if ($COMMAND_RETURN_ADDR_POLICY eq 'from' ||
	$MESSAGE_RETURN_ADDR_POLICY eq 'from') {
	$e{'Addr2Reply:'} = $From_address;
    }
    else { # $MESSAGE_RETURN_ADDR_POLICY eq 'reply-to'
	$e{'Addr2Reply:'} = &Conv2mailbox($e{'h:reply-to:'},*e)||$From_address;
    }

    # KAKUSHI(SECRET) OPTION :) (UNDER DEVELOPMENT)
    # use Return-Path: as the sender for authentication
    if ($SENDER_AUTH_TYPE eq 'strict-envelope-from') {
	$_ = &Conv2mailbox($Envelope{'h:return-path:'}, *e);
	if ($_) {
	    $From_address = $_;
	}
	else {
	    &Log("\$SENDER_AUTH_TYPE eq 'strict-envelope-from'");
	    &Log("INVALID Return-Path:<$_>");
	    &Mesg(*e, "YOU ARE NOT A MEMBER!");
	    &Mesg(*e, $NULL, 'not_member');
	    $DO_NOTHING = 1;
	}

    }
    elsif ($SENDER_AUTH_TYPE eq 'envelope-from-or-from') {
	for ($UnixFrom, $From_address) {
	    &MailListMemberP($_) && ($From_address = $_, last);
	}
    }

    # To: $MAIL_LIST for readability;
    # &RewriteField(*e, 'Cc') unless $NOT_REWRITE_CC;
    if ($REWRITE_TO < 0) { 
	; # pass through for the use of this flag when $CFVersion < 3.;
    }
    elsif ($CFVersion < 3.1) { # 3.1 is 2.1A#8 (1997/10/14) 
	$REWRITE_TO = $NOT_REWRITE_TO ? 0 : 1; # 2.1 release default;
    }
    
    &Log("REWRITE_TO $REWRITE_TO") if $debug;
    if ($REWRITE_TO == 2) {
	$e{'h:To:'} = "$MAIL_LIST $ML_FN"; # force the original To: to pass
    }
    elsif ($REWRITE_TO == 1) {
	# To: $MALI_LIST, plus original To: ...
	$e{'h:To:'} = "$MAIL_LIST $ML_FN";
	&RewriteField(*e, 'To');
    }
    elsif ((!$REWRITE_TO) || $REWRITE_TO < 0) {
	; # do nothing, pass through
    }

    # Subject:
    # 1. remove [Elena:id]
    # 2. while ( Re: Re: -> Re: ) (THIS IS REQUIED ANY TIME, ISN'T IT? but...)
    # Default: not remove multiple Re:'s),
    # which actions may be out of my business
    if ($_ = $e{'h:Subject:'}) {
	if ($STRIP_BRACKETS || 
	    $SUBJECT_FREE_FORM_REGEXP || $SUBJECT_HML_FORM) {
	    if ($e{'MIME'}) { # against cc:mail ;_;
		&use('MIME'); 
		&StripMIMESubject(*e);
	    }
	    else { # e.g. Subject: [Elena:003] E.. U so ...;
		print STDERR "IN: $_\n" if $debug;
		$e{'h:Subject:'} = &StripBracket($_);
		print STDERR "OUT: $e{'h:Subject:'}\n" if $debug;
	    }
	} 
	# Even if pass through, always strip of Re:* 
	else {
	    $e{'h:Subject:'} = &CutOffRe($_);
	}
    }

    # Obsolete Errors-to:, against e.g. BBS like a nifty
    if ($USE_ERRORS_TO) {
	$e{'h:Errors-To:'} = $ERRORS_TO || $MAINTAINER;
    }
    else { # delete obsolete fields;
	&DELETE_FIELD('Errors-To');
    }

    # Set Control-Address for reply, notify and message
    $e{'CtlAddr:'} = &CtlAddr;

    ### USER MACROS: &COPY_FIELD(old, new);
    local($old, $new);
    while (($old,$new) = each %HdrFieldCopy) {
	&Debug("COPY_FIELD: \$e{\"h: $old => $new\"}") if $debug;
	$e{"h:$new:"} = $e{"h:$old:"};
	$e{"h:$new:"} =~ s/\n$old:/\n$new:/gi;
    }
}

sub FieldCapitalize
{	
    local($_) =  @_;
    s/^(\w)/ $x = $1, $x =~ tr%a-z%A-Z%, $x/e;
    s/(\-\w)/$x = $1, $x =~ tr%a-z%A-Z%, $x/eg;
    $_ =~ s/^X-ML-/X-ML-/i; # X-ML- is an exception. to avoid dup of X-M{L,;}
    $_;
}

sub StripBracket
{
    local($_) = @_;
    local($pat);

    if ($SUBJECT_FREE_FORM_REGEXP) {
	$pat = $SUBJECT_FREE_FORM_REGEXP;
    }
    else { # default;
	# pessimistic ?
	if (! $BRACKET) { ($BRACKET) = split(/\@/, $MAIL_LIST);}

	$pat = "\\[$BRACKET:\\d+\\]";
    }

    # cut out all the e.g. [BRACKET:\d] form;
    s/$pat//g;

    $_ = &CutOffRe($_);
}

sub CutOffRe
{
    local($_) = @_;
    local($pattern);

              #  Re: Re2:   Re[2]:     Re(2):     Re^2:    Re*2:
    $pattern  = 'Re:|Re\d+:|Re\[\d+\]:|Re\(\d+\):|Re\^\d+:|Re\*\d+:';
    s/^(\s*($pattern)\s*)+/Re: /oi;

    if ($LANGUAGE eq 'Japanese') { 
	require("module/$LANGUAGE/liblangdep.pl");
	$_ = &Japanese'CutOffReReRe($_);
    }

    $_;
}

sub _get_boundary
{
    my ($content_type) = @_;

    for my $param (split(/[;\s]+/, $content_type)) {
	if ($param =~ /boundary=\"(.*)\"/i ||
	    $param =~ /boundary=\s*(\S+)/i) {
	    return $1;
	}
    }

    return undef;
}

sub CheckCurrentProc
{
    local(*e, $ccp_mode) = @_;
    
    # log
    &Log("read $e{'tmp:bufsiz'} bytes") if $debug_fml_org;
    undef $e{'tmp:bufsiz'};

    ### SubSection: Log socket connection info
    &eval("&use('kernsubr2'); &GetPeerInfo;") if $LOG_CONNECTION;

    ### SubSection: Check Body Contents (For Command Mode)
    local($limit, $p, $buf, $boundary, $nclines, $cc);

    ### SubSection: MIME info
    # MIME skip mode; against automatic-MIME-encapsulated fool MUA
    if ($boundary = _get_boundary($e{'h:content-type:'})) {
	$boundary = "--$boundary";
	$e{'MIME:boundary'} = $boundary;
    }
    elsif ($e{'h:content-type:'} =~ /multipart/i) {
	&Log("cannot get boundary string of Content-Type");
	&Log("Content-Type: $e{'h:content-type:'}");
    }

    ### SubSection: Check command in mail body
    # the range to scan
    $limit =  $GUIDE_CHECK_LIMIT > $COMMAND_CHECK_LIMIT ? 
	$GUIDE_CHECK_LIMIT  : $COMMAND_CHECK_LIMIT;

    ## QMAIL command hook
    ## dot-qmail(5) ~alias/.uja-default emulates uja-help@domain ("-> #help")
    if ($USE_DOT_QMAIL_EXT && 
	(!&AddressMatch($MAIL_LIST, $ENV{'RECIPIENT'}))) { 
	&Log("sets in dot-qmail-ext") if $debug_qmail;
	&use('qmail'); 
	&DotQmailExt(*Envelope);
    }

    # search the location of $limit's "\n";
    $limit += 10; # against MIME
    $p = 0;
    while ($limit-- > 0) { 
	if (index($e{'Body'}, "\n", $p + 1) > 0) {
	    $p = index($e{'Body'}, "\n", $p + 1);
	}
	else {
	    last;
	}
    }
    # +1 for the last "\n";
    $buf = substr($e{'Body'}, 0, $p > 0 ? $p+1 : 1024);

    # check only the first $limit lines.
    local($found, $mime_skip);
    for (split(/\n/, $buf)) {
	print STDERR "INPUT BUF> $_\n" if $debug;

	# subscribe trap
	# XXX: "# command" is internal represention
	# XXX: remove '# command' part if exist
	if (/^(\s*|\#\s*)$CONFIRMATION_SUBSCRIBE\s+/i) {
	    $e{'mode:req:subscribe'} = 1;
	    $e{'buf:req:subscribe'} .= $_."\n";
	}

	if ($CHADDR_AUTH_TYPE eq 'confirmation' &&
	    (/^(\s*|\#\s*)$CHADDR_KEYWORD\s+/i)) {
	    $e{'mode:req:chaddr'} = 1;
	    $e{'buf:req:chaddr'} .= $_."\n";
	}

	# chaddr-confirm trap (may be with citatin e.g. ">")
	if ($CHADDR_AUTH_TYPE eq 'confirmation' &&
	    /$CHADDR_CONFIRMATION_KEYWORD\s+\S+/i) {
	    $e{'mode:req:chaddr-confirm'} = 1;
	    $e{'buf:req:chaddr-confirm'} .= $_."\n";
	}
	# confirm trap (may be with citatin e.g. ">")
	elsif (/$CONFIRMATION_KEYWORD\s+\S+/i) {
	    $e{'mode:req:confirm'} = 1;
	    $e{'buf:req:confirm'} .= $_."\n";
	}

	# unsubscribe-confirm ID
	if (/($UNSUBSCRIBE_CONFIRMATION_KEYWORD\s+\S+.*)/i) {
	    $e{'buf:req:unsubscribe-confirm'} .= $1."\n";
	    $e{'mode:req:unsubscribe-confirm'} = 1;
	}

	if ($boundary) { # if MIME skip mode;
	    if ($_ eq $boundary) { $found++; $mime_skip++; next;}
	    if (/^Content-Type:/i && $mime_skip) { next;}
	    # skip the null line after the first MIME separator
	    if ($mime_skip) { $mime_skip = 0; next;} 
	}

	# skip before the first MIME boundary
	next if $boundary && !$found;

	$cc++;
	print STDERR " SCAN BUF> $_ ($cc line)\n\n" if $debug;

	# DO NOT "skip useless checks (2.23?)"
	# which we uses in the "guide" request check from a stranger.
	# if (! $e{'trap:ctk'}) {
	#    print STDERR "  -skip fml rel. 1 compatible scan\n" if $debug;
	#    next;
	# }

	# Guide Request from the unknown
	if ($GUIDE_CHECK_LIMIT-- > 0) { 
	    $e{'mode:req:guide'} = 1 if /^\#\s*$GUIDE_KEYWORD\s*$/i;

	    # accept 'guide' under --ctladdr;
	    $e{'mode:req:guide'} = 1
		if $e{'mode:ctladdr'} && /^\s*$GUIDE_KEYWORD\s*$/i;
	}

	# Command or not is checked within the first 3 lines.
	# '# help\s*' is OK. '# guide"JAPANESE"' & '# JAPANESE' is NOT!
	# BUT CANNOT JUDGE '# guide "JAPANESE CHARS"' SYNTAX;-);
	if ($COMMAND_CHECK_LIMIT-- > 0) { 
	    $e{'mode:uip'} = 'on'    if /^\#\s*[\w\-]+\s|^\#\s*[\w\-]+$/;
	    $e{'mode:uip:chaddr'} = $_ 
		if /^\#\s*($CHADDR_KEYWORD)\s+/i;
	    $e{'mode:uip:chaddr-confirm'} = $_ 
		if /^\#\s*($CHADDR_CONFIRMATION_KEYWORD)\s+/i;
	}

	$nclines++ if /^\#/o;    # the number of command lines
    }

    ### close(STDIN); # close(STDIN) prevents open2, really?

    $e{'nlines'}  = ($e{'Body'} =~ tr/\n/\n/);
    $e{'nclines'} = $nclines;
    $e{'size'}    = $bufsiz;
    $e{'h:Lines:'} = $e{'nlines'};

    ### SubSection: special trap
    return 0 if $CheckCurrentProcUpperPartOnly;
    return 0 if $ccp_mode eq 'upper_part_only';

    ### SubSection: MailBody Size
    if ($e{'trap:mail_size_overflow'}) {
	&use('error');
	&NotifyMailSizeOverFlow(*e);

	if ($ANNOUNCE_MAIL_SIZE_OVERFLOW) {
	    &AnnounceMailSizeOver(*e); # call &Distribute;
	}
	else {
	    $DO_NOTHING = 1;
	    return $NULL;
	}
    }

    # Against a lot of mails for MIME partial, e.g. Outlook
    # Content-Type: message/partial; number=1; total=6; ...
    if ($e{'h:content-type:'} =~ /\/partial\s*;/ && 
	$INCOMING_MAIL_SIZE_LIMIT) {
	local($n, $total, $bufsiz);

	$e{'h:content-type:'} =~ s/number=(\d+)/$n = $1/e;
	$e{'h:content-type:'} =~ s/total=(\d+)/$total = $1/e;
	$bufsiz = length($Envelope{'Body'}) * $total;

	if ($bufsiz > &ATOI($INCOMING_MAIL_SIZE_LIMIT)) {
	    &Log("reject for too large size mail");
	    &Log("partial message's <$n/$total> total mail size seems too large");
	    &Log("evaluated whole size $bufsiz > \$INCOMING_MAIL_SIZE_LIMIT[$INCOMING_MAIL_SIZE_LIMIT]");

	    # WARNING in n ==1 partial case.
	    if ($n == 1 && $NOTIFY_MAIL_SIZE_OVERFLOW) {
		&use('error');
                &NotifyMailSizeOverFlow(*e);
	    } 

	    if ($n == 1 && $ANNOUNCE_MAIL_SIZE_OVERFLOW) {
		&use('error');
		&AnnounceMailSizeOver(*e); # call &Distribute;
	    }
	    else {
		$DO_NOTHING = 1;
	    }
	}
	else {
	    &Log("partial message but the whole size seems enough small")
		if $debug;
	}
    }

    ### SubSection: Access Control based on address
    ## WE SHOULD REJCECT "CANNOT IDENTIFIED AS PERSONAL" ADDRESSES;
    ##   In addition, we check another atack possibility;
    ##      e.g. majorodmo,listproc,list-subscribe <-> fml-ctl 
    if ($REJECT_ADDR && $From_address =~ /^($REJECT_ADDR)\@(\S+)/i) {
	local($addr, $domain) = ($1, $2);
	&Log("reject mail from $addr\@$domain");
	&WarnE("reject mail from $addr\@$domain", 
	       "reject mail from $addr\@$domain\n");
	$DO_NOTHING = 1;
	return 0;
    }

    # XXX reject all "From: MAIL_LIST" mails (3.0)
    # XXX fix for 3.0.1
    # XXX controllable by %LOOP_CHECKED_HDR_FIELD.
    if (%LOOP_CHECKED_HDR_FIELD) {
	my($f, $v);

	for $f (keys %LOOP_CHECKED_HDR_FIELD) {
	    next unless $LOOP_CHECKED_HDR_FIELD{$f};
	    if ($v = $e{"h:${f}:"}) {
		$v = &Conv2mailbox($v);
		if (&LoopBackWarn($v)) {
		    &Log("$f: <$v> may cause loop. rejected");
		    &WarnE("reject mail $f:<$v>",
			   "rejected since '$f' header\n".
			   "may cause mail loop.\n".
			   "${f}: ".
			   $e{"h:${f}:"}.
			   "\n");
		    $DO_NOTHING = 1;
		    return 0;
		}
	    }
	}
    }

    ## security level (?)
    while (($k, $v) = each %SEVERE_ADDR_CHECK_DOMAINS) {
	print STDERR "/$k/ && ADDR_CHECK_MAX += $v\n" if $debug; 
	($From_address =~ /$k/) && ($ADDR_CHECK_MAX += $v);
    }

    # AGAINST SPAM MAILS
    if (-f $REJECT_ADDR_LIST) {
	if (&RejectAddrP($From_address) ||
	    &RejectAddrP($UnixFrom)) {
	    $s="Reject spammers: UnixFrom=[$UnixFrom], From=[$From_address]";
	    &WarnE("Spam mail from a spammer is rejected $ML_FN",
		  "Reject Spammers:\n".
		  "   UnixFrom\t$UnixFrom\n   From\t\t$From_address\n");
	    &Log($s);
	    $DO_NOTHING = 1;
	    return 0;
	}
    }

    ### SubSection: misc
    ### For CommandMode Check(see the main routine in this flie)
    $e{'trap:rcpt_fields'}  = $e{'h:to:'} || $e{'h:apparently-to:'};
    $e{'trap:rcpt_fields'} .= ", $e{'h:Cc:'}, ";
    $e{'trap:rcpt_fields'}  =~ s/\n(\s+)/$1/g;

    # SUBJECT: GUIDE SYNTAX 
    if ($USE_SUBJECT_AS_COMMANDS && $e{'h:Subject:'}) {
	local($_) = $e{'h:Subject:'};
	s/^\s*//;

	$e{'mode:req:guide'}++ if /^\#\s*$GUIDE_KEYWORD\s*$/i;
	$e{'mode:uip'} = 'on'  if /^\#\s*[\w\-]+\s|^\#\s*[\w\-]+$/;
	$e{'mode:req:guide'}++          
	    if $COMMAND_ONLY_SERVER && /^\s*$GUIDE_KEYWORD\s*$/i;
	$e{'mode:uip'} = 'on' 
	    if $COMMAND_ONLY_SERVER && /^\s*[\w\-]+\s|^\s*[\w\-]+$/;
    }    

    # ? for --distribute, here and again in &MLMemberCheck; 
    &AdjustActiveAndMemberLists;

    ### SubSection: debug info dump
    if ($debug) { &eval(&FieldsDebug, 'FieldsDebug');}

    ### SubSection: Mail Loop Check
    ## LOOP CHECK PHASE 1: Message-Id
    if ($CHECK_MESSAGE_ID && &DupMessageIdP) { exit 0;}

    ## LOOP CHECK PHASE 2
    # now before flock();
    if ((! $NOT_USE_UNIX_FROM_LOOP_CHECK) && 
	&AddressMatch($UnixFrom, $MAINTAINER)) {
	&Log("WARNING: UNIX FROM Loop[$UnixFrom == $MAINTAINER]");
	&WarnE("WARNING: UNIX FROM Loop",
	      "UNIX FROM[$UnixFrom] == MAINTAINER[$MAINTAINER]\n\n");
	exit 0;
    }

    ### SubSection: Address Test Mode; (Become Test Mode)
    if ($Opt{"opt:b"} eq 't') { 
	$DO_NOTHING = 1; &Log("Address Test Mode:Do nothing");
    } 

    ### SubSection: Crosspost emulation
    # Check crosspost in To: and Cc:
    if ($USE_CROSSPOST) { &use('crosspost');}
}

# We REWRITED To: to "To: MAIL_LIST" FOR MORE READABILITY;
# Check the To: and overwrite it;
# if To: has $MAIL_LIST, ok++; IF NOT, add $MAIL_LIST to To:
sub RewriteField
{
    local(*e, $ruleset) = @_;
    local($f) = 'RuleSetTo' if $ruleset eq 'To';
    $f ? &$f(*e) : &Log("RewriteField: unknown ruleset $ruleset");
}

# 2000/11/17 version is modified to use Mail::Address.pm 
# based on the patch by OGAWA Kunihiko <kuni@edit.ne.jp>
sub RuleSetTo
{
    local(*e) = @_;
    local($ok, $match, $addr, $x_addr, $ml, $buf, $to);
    local(@ml) = ($MAIL_LIST, @MAIL_LIST_ALIASES); # PLAY_TO Trick;

    eval "require Mail::Address; Mail::Address->import();";

    # if fails, call fml 3.0 compatible routine.
    if ($@ ne '') {
	&Log("WARN: Mail::Address.pm not works well");
	&Log("disable RuleSetTo function");
	return $NULL;
    }

    # search $MALI_LIST (+ aliases) contained in To: ?
    $to = $e{'h:to:'};
    $to =~ s/\s*To: /, /gi;
    for $addr (Mail::Address->parse($to)) {
	$x_addr = $addr->format;
	$addr   = $addr->address;
	$match  = 0;

	# match one of $MALI_LIST ?
	for $ml (@ml) { 
	    # ignore $MALI_LIST (or aliases) addresses to avoid noisy To;)
	    if (&AddressMatch($addr, $ml)) { $ok++; $match = 1;}
	}

	# IF NOT match one of $MAIL_LIST,
	# gobble not $MALI_LIST address to $buf
	if (! $match) {
	    $buf .= $buf ? ", ". $addr : $addr;
	    &Log("RuleSetTo: buf = {$buf}") if $debug;
	}
    }

    if ($buf) {
	$e{'h:To:'} .= $e{'h:To:'} ? "\n\t,".$buf : $buf;
    }
}

# Expand mailbox in RFC822
# From_address is user@domain syntax for e.g. member check, logging, commands
# return "1#mailbox" form ?(anyway return "1#1mailbox" 95/6/14)
#
# macro:x is moved to FixHeaderFields (97/05/07 fukui@sonic.nm.fujitsu.co.jp)
#
# 2000/11/17 version is modified to use Mail::Address.pm 
# based on the patch by OGAWA Kunihiko <kuni@edit.ne.jp>
sub Conv2mailbox
{
    local($mb, *e) = @_;	# original string
    local($addr);

    eval "require Mail::Address; Mail::Address->import();";

    # if fails, call fml 3.0 compatible routine.
    if ($@ ne '') {
	&Log($@);
	&Log("WARN: Mail::Address.pm not works well");
	return &__Conv2mailbox30($mb, *e);
    }

    # NULL is given, return NULL
    ($mb =~ /^\s*$/) && (return $NULL);

    ($addr) =  (Mail::Address->parse($mb))[0];
    return $NULL unless $addr;

    $e{'tmp:x'} = $addr->phrase . $addr->comment;
    return $addr->address;
}

sub __Conv2mailbox30
{
    local($mb, *e) = @_;	# original string

    # return NULL if addr does not contain @. ?
    # return $NULL unless $mb =~ /\@/;

    # $mb = &Strip822Comments($mb);

    # NULL is given, return NULL
    ($mb =~ /^\s*$/) && (return $NULL);

    # RFC822 unfolding and cut the first SPACE|HTAB;
    $mb =~ s/\n(\s+)/$1/g;
    $mb =~ s/^\s*//;

    # Hayakawa Aoi <Aoi@aoi.chan.panic>
    if ($mb =~ /^\s*(.*)\s*<(\S+)>.*$/io) { $e{'tmp:x'} = $1; return $2;}

    # Aoi@aoi.chan.panic (Chacha Mocha no cha nu-to no 1)
    if ($mb =~ /^\s*(\S+)\s*\((.*)\)$/io || $mb =~ /^\s*(\S+)\s*(.*)$/io) {
	$e{'tmp:x'} = $2, return $1;	
    }

    # Aoi@aoi.chan.panic
    return $mb;
}	

# When just guide request from unknown person, return the guide only
# change reply-to: for convenience
sub GuideRequest
{
    local(*e) = @_;
    local($ap);

    if ($debug) { @c=caller; &Log("GuideRequest called from $c[2]");}

    &Log("Guide request");

    $e{'GH:Reply-To:'} = $e{'CtlAddr:'}; 
    &SendFile($e{'Addr2Reply:'}, "Guide $ML_FN", $GUIDE_FILE);
}

# MAIL_LIST == CONTROL_ADDRESS or !CONTROL_ADDRESS ?
# ATTENTION! 
#   if cf == 3, !$CONTROL_ADDRESS IS JUST "distribute only"
#   if cf  < 2, !$CONTROL_ADDRESS => Command($MAIL_LIST==$CONTROL_ADDRESS)
sub CompatFMLv1P
{
    local($ml) = split(/\@/, $MAIL_LIST); 
    local($ca) = split(/\@/, $CONTROL_ADDRESS);

    if ($CFVersion < 3) { return &CF2CompatFMLv1P($ca, $ml);}

    # Version 3, criterion is only "MAIL_LIST == CONTROL_ADDRESS"
    $ml eq $ca && return 1;
    $MAIL_LIST eq $CONTROL_ADDRESS && return 1;

    # Version 3, compat mode for before FML 2.1 
    $MAIL_LIST_ACCEPT_COMMAND && return 1;

    0;
}

# Distribute mail to members (fml.pl -> libdist.pl)
sub Distribute
{
    local(*e, $mode, $compat_hml) = @_;
    local($ml) = (split(/\@/, $MAIL_LIST))[0];

    # Japanese specific: convert hankaku to zenkaku
    if ($USE_HANKAKU_CONVERTER) {
	if ($LANGUAGE eq 'Japanese') { 
	    require("module/$LANGUAGE/libhankaku2zenkaku.pl");
	    eval &FixJapaneseMDChars(*e);
	    &Log($@) if $@;
	}
    }

    # Filtering mail body from members but not check other cases
    # e.g. null body subscribe request in "no-keyword" case
    if ($USE_DISTRIBUTE_FILTER) {
	&EnvelopeFilter(*e, 'distribute');
	return $NULL if $DO_NOTHING;
    }

    # check duplication baesd on mailbody MD5 cksum cache
    if ($CHECK_MAILBODY_CKSUM) {
	&use('cksum');

	if (&CheckMailBodyCKSUM(*e)) {
	    # looped !
	    $DO_NOTHING = 1;
	    return $NULL;
	}
	else {
	    # not looped ! O.K. now cache on for the future
	    &CacheMailBodyCksum(*e);
	}
    }

    # Cut off multipart or reject by mail's Content-Type handler
    # The existence of $AGAINST_HTML_MAIL and $HTML_MAIL_DEFUALT_HANDLER
    # are backward compatible.
    if (@MailContentHandler > 0) {
	&use('disthack'); 
    	my ($status) = &ContentHandler(*e);
	if ($status eq 'reject') { return $NULL;}
    }

    # Security: Mail Traffic Information
    if ($USE_MTI) { 
	&use('mti'); 
	&MTICache(*e, 'distribute');
	return $NULL if &MTIError(*e);
    }

    if ($debug) { @c = caller; &Log("Distritute called from $c[2] ");}

    if ($mode eq 'permit from members_only') {
	$Rcsid .= "; post only (only members can post)";
    }
    elsif ($mode eq 'permit from anyone') {
	$Rcsid .= "; post only (anyone can post)"; 
    }
    elsif ($mode eq 'permit from moderator') {
	$Rcsid =~ s/^(.*)(\#\d+:\s+.*)/$1."(moderated mode)".$2/e;
	undef $e{'h:approval:'}; # delete the passwd entry;
	undef $e{'h:Approval:'}; # delete the passwd entry;
    }
    ### NOT REMOVE FOR BACKWARD?
    else {
	$Rcsid .= "; post + commands (members only)"; # default ;
    }

    if ($MAIL_LIST eq $CONTROL_ADDRESS) {
        $Rcsid =~ s/post only (from.*)/post $1 + commands/;
    }


    # Dabasase access: dump recipients
    if ($USE_DATABASE) {
	my (%mib, %result, %misc, $error);
	&DataBaseMIBPrepare(\%mib, 'dump_active_list');
	&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc);
	&Log("fail to dump active list") if $mib{'error'};
	return $NULL if  $mib{'error'};

	# tricky but effective 
	# we push cache file to recipient lists, so that
	# @ACTIVE_LIST = ($ACTIVE_LIST, $mib{'_cache_file'});
	push(@ACTIVE_LIST, $mib{'_cache_file'}) if -f $mib{'_cache_file'};
	&Log("ACTIVE = ( @ACTIVE_LIST )") if $debug;
    }

    require 'libdist.pl';
    &DoDistribute(*e);	
}

sub RunStartHooks
{
    $0 = "${FML}: RunStartHooks <$MyProcessInfo>";

    # additional before action
    $START_HOOK && &eval($START_HOOK, 'Start hook');

    for (keys %FmlStartHook) {
	print STDERR "Run StartHook $_ -> $FmlStartHook{$_}\n" if $debug;
	next unless $FmlStartHook{$_};
	$0 = "${FML}: Run FmlStartHook [$_] <$MyProcessInfo>";
	&eval($FmlStartHook{$_}, "Run FmlStartHook [$_]");
    }
}

sub RunEndHooks
{
    $0 = "${FML}: RunEndHooks <$MyProcessInfo>";

    # additional before action
    $END_HOOK && &eval($END_HOOK, 'END_HOOK');

    for (keys %FmlEndHook) {
	print STDERR "Run EndHook $_ -> $FmlEndHook{$_}\n" if $debug;
	next unless $FmlEndHook{$_};
	$0 = "${FML}: Run FmlEndHook [$_] <$MyProcessInfo>";
	&eval($FmlEndHook{$_}, "Run FmlEndHook [$_]");
    }
}

# Lastly exec to be exceptional process
sub ExExec { &RunHooks(@_);}
sub RunExitHooks
{
    local($s);
    $0 = "${FML}: RunExitHooks <$MyProcessInfo>";

    # FIX COMPATIBILITY
    $FML_EXIT_HOOK .= $_PCB{'hook', 'str'};

    if ($s = $FML_EXIT_HOOK) {
	print STDERR "\nmain::eval >$s<\n\n" if $debug;
	$0 = "${FML}: Run Hooks(eval) <$MyProcessInfo>";
	&eval($s, 'Run Hooks:');
    }
    
    for (keys %FmlExitHook) {
	print STDERR "Run hooks $_ -> $FmlExitHook{$_}\n" if $debug;
	next unless $FmlExitHook{$_};
	$0 = "${FML}: Run FmlExitHook [$_] <$MyProcessInfo>";
	&eval($FmlExitHook{$_}, "Run FmlExitHook [$_]");
    }
}

sub ExecNewProcess
{
    $0 = "${FML}: Run New Process <$MyProcessInfo>";
    $FML_EXIT_PROG .= $_PCB{'hook', 'prog'};
    if ($FML_EXIT_PROG) { &use('kernsubr2'); &__ExecNewProcess;}
}

sub SpawnProcess
{
    local(@xargv) = @_; &use('kernsubr2'); &__SpawnProcess(@xargv);
}

####### Section: Member Check
# fix array list;
#
# files to check for the authentication 96/09/17
# @MEMBER_LIST = ($MEMBER_LIST) unless @MEMBER_LIST;
sub AdjustActiveAndMemberLists
{
    local($f, $status);

    if ($status = &AutoRegistrableP) {
	# automatic asymmetric registration
	# XXX: fml 2.x auto_asymmetric_regist fakes "only member list".
	if ($status eq "auto_asymmetric_regist") {
	    $FILE_TO_REGIST = $FILE_TO_REGIST || $ACTIVE_LIST;
	    &Touch($FILE_TO_REGIST) unless -f $FILE_TO_REGIST;
	}
	# XXX: fml 2.x auto_regist uses only member file.
	# XXX: fml 3.x auto_subscribe uses actives and members.
	elsif (&NotUseSeparateListP) {
	    # XXX: this block is always true in 2.x but false in 3.x.
	    $ACTIVE_LIST = $MEMBER_LIST;
	    for (@MEMBER_LIST) {
		grep(/$_/, @ACTIVE_LIST) || push(@ACTIVE_LIST, $_);
	    }
	}
    }

    grep(/$MEMBER_LIST/, @MEMBER_LIST) || push(@MEMBER_LIST, $MEMBER_LIST);
    grep(/$ACTIVE_LIST/, @ACTIVE_LIST) || push(@ACTIVE_LIST, $ACTIVE_LIST);

    if (($f = $FILE_TO_REGIST) && -f $FILE_TO_REGIST) {
	grep(/$f/, @MEMBER_LIST) || push(@MEMBER_LIST, $f);
	grep(/$f/, @ACTIVE_LIST) || push(@ACTIVE_LIST, $f);
    }
    elsif (-f $FILE_TO_REGIST) {
	&Log("ERROR: \$FILE_TO_REGIST NOT EXIST");
    }

    # ONLY IF EXIST ALREADY, add the admin list (if not, noisy errors...;-)
    if (($f = $ADMIN_MEMBER_LIST) && -f $ADMIN_MEMBER_LIST) {
	grep(/$f/, @MEMBER_LIST) || push(@MEMBER_LIST, $f);
    }
}

# if found, return the non-null file name;
sub DoMailListMemberP
{
    local($addr, $type) = @_;
    local($file, @file, %file);

    # DataBase Access
    if ($USE_DATABASE) {
	&use('databases');

	my ($action) = $type eq 'm' ? 'member_p' : 'active_p';

	# try to access database to verify the server is alive
	# and try to verify the address is member or not.
	my (%mib, %result, %misc, $error);
	&DataBaseMIBPrepare(\%mib, $action, {'address' => $addr});
	&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc);

       # if search fails for $MEMBER_LIST,
       if ( !$mib{'_result'} && ($type eq 'm')) {
           # retry search in $ADMIN_MEMBER_LIST
           my (%xmib, %result, %misc, $error);
           &DataBaseMIBPrepare(\%xmib,'admin_member_p',{'address' => $addr});
           &DataBaseCtl(\%Envelope, \%xmib, \%result, \%misc);

           # search fails for both $MEMBER_LIST and $ADMIN_MEMBER_LIST
           if ($xmib{'error'}) {
               return 0;
           }
           else {
               $mib{ _result } = $xmib{ _result };
           }
       }
       # if search fails for $ACTIVE_LIST, return here ASAP.
       elsif ($mib{'error'}) {
           return 0;
       }

	$Envelope{'database:cache:$action'} = 1 if $mib{'_result'};

	return $mib{'_result'};
    }
    # XXX  not reach here when you use $USE_DATABASE

    $SubstiteForMemberListP = 1;

    @file = $type eq 'm' ? @MEMBER_LIST : @ACTIVE_LIST;

    for $file (@file) {
	next unless -f $file;
	next if $file{$file}; $file{$file} = 1; # uniq 

	# prohibit ordinary people operations (but should permit probing only)
	# NOT CHECK OUTSIDE "amctl" procedures in &Command;
	# WITHIN "amctl"
	# check also $ADMIN_MEMBER_LIST if IN ADMIN MODE
	# ignore     $ADMIN_MEMBER_LIST if NOT IN ADMIN MODE
	if ($e{'mode:in_amctl'} &&            # in "amctl" library
	    ($file eq $ADMIN_MEMBER_LIST) &&
	    (! $e{'mode:admin'})) {           # called NOT in ADMIN MODE
	    next;
	}

	if ($debug && -f $file) {
	    &Debug("   DoMailListMemberP(\n\t$addr\n\tin $file);\n");
	}

	if (-f $file && &Lookup($addr, $file)) {
	    &Debug("+++Hit: $addr in $file") if $debug;
	    $SubstiteForMemberListP = 0;
	    return $file;
	}
    }
    $SubstiteForMemberListP = 0;

    if ($IDENTIFY_MIGRATING_DOMAIN) {
	# avoid recursive call under libmgrdom.pl
	return $NULL if $Envelope{'mode:in_mgrdom'};
	&use('mgrdom');
	&MgrdomConsider($addr, $type);
    }
    else {
	$NULL;
    }
}


# Descriptions: search map having $addr in member lists 
#               without the admin member list.
#    Arguments: STR($addr)
# Side Effects: none
# Return Value: STR
sub GetTargetMemberList
{
    my ($addr) = @_;
    my (@orig) = @MEMBER_LIST;
    my (@new)  = ();

  MAP:
    for my $map (@MEMBER_LIST) {
	next MAP if $map eq $ADMIN_MEMBER_LIST;
	push(@new, $map);
    }

    @MEMBER_LIST = @new;
    my $r = &DoMailListMemberP(@_, 'm');
    @MEMBER_LIST = @orig;

    return $r;
}
 

sub MailListMemberP { return &DoMailListMemberP(@_, 'm');}
sub MailListActiveP { return &DoMailListMemberP(@_, 'a');}

sub MailListAdminMemberP
{ 
    my ($addr) = @_;

    # DataBase Access
    if ($USE_DATABASE) {
	&use('databases');

	my (%mib, %result, %misc, $error);
	&DataBaseMIBPrepare(\%mib, 'admin_member_p', {'address' => $addr});
	&DataBaseCtl(\%Envelope, \%mib, \%result, \%misc); 
       if ($mib{'error'}) { return 0;}

	$Envelope{'database:cache:admin_member_p'} = 1 if $mib{'_result'};

	return $mib{'_result'};
    }
    else {
	&Lookup($addr, $ADMIN_MEMBER_LIST);
    }
}

sub NonAutoRegistrableP { ! &AutoRegistrableP;}
sub AutoRegistrableP
{
    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;
    }
}

# canonicalize address for database storing 
# since we search it in case sensitive mode.
# preserve case in localpart but not in domain part
sub TrivialRewrite
{
    my ($addr) = @_;
    my ($local, $domain) = split(/\@/, $addr);
    $domain =~ tr/A-Z/a-z/;
    $local. '@'. $domain;
}

sub AutoRegistHandler
{
    if ($debug) { @c = caller; &Log("AutoRegistHandler called from $c[2]");}

    &use('amctl');
    &AutoRegist(*Envelope);
}

sub RejectHandler
{
    if ($debug) { @c = caller; &Log("RejectHandler called from $c[2]");}

    &Log("Rejected: \"From:\" field is not member");
    &WarnE("NOT MEMBER article from $From_address $ML_FN", 
	   "NOT MEMBER article from $From_address\n\n");
    if (-f $DENY_FILE) {
	&SendFile($From_address, 
		  "You $From_address are not member $ML_FN", $DENY_FILE);
    }
    else {
	&Mesg(*Envelope, 'you are not member.', 'info.reject');
    }
}

sub IgnoreHandler
{
    &Log("Ignored: \"From:\" field is not member");
    &WarnE("Ignored NOT MEMBER article from $From_address $ML_FN", 
	   "Ignored NOT MEMBER article from $From_address");
}

# Lookup(key, file); return 1 if the "key" is found in the "file".
# e.g. Lookup(addr, member-list-file)
# return 1 if a given address is authenticated as member's (found in the file).
#
# performance test example 1 (100 times for 158 entries == 15800)
# fastest case
# old 1.880u 0.160s 0:02.04 100.0% 74+34k 0+1io 0pf+0w
# new 1.160u 0.160s 0:01.39 94.9% 73+36k 0+1io 0pf+0w
# slowest case
# old 20.170u 1.520s 0:22.76 95.2% 74+34k 0+1io 0pf+0w
# new 9.050u  0.190s 0:09.90 93.3% 74+36k 0+1io 0pf+0w
#
# the actual performance is the average between values above 
# but the new version provides stable performance.
#
sub CheckMember { &Lookup(@_);}
sub Lookup
{
    local($address, $file) = @_;
    local($addr, $has_special_char, $auto_registrable);

    # mode
    $auto_registrable = &AutoRegistrableP;

    # more severe check;
    $address =~ s/^\s*//;
    if ($address =~ /\@/) { # RFC822 addrspec
	($addr) = split(/\@/, $address);
    }
    else { # not addrspec, arbitrary string
	$addr = substr($address, 0, 8);
    }
    
    # MUST BE ONLY * ? () [] but we enhance the category -> shell sc
    # add + (+ed user) 1998/11/08
    if ($addr =~ /[\+\$\&\*\(\)\{\}\[\]\'\\\"\;\\\\\|\?\<\>\~\`]/) {
	$has_special_char = 1; 
    }

    open(LOOKUP_TABLE, $file) || do {
	&Log("LookUp: cannot open $file");
	return 0;
    };
  getline: while (<LOOKUP_TABLE>) {
      chop; 

      if ($auto_registrable || $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 (/^\+\s*$/o) { 
	  &Debug("encounter + [$_]") if $debug;
	  $Envelope{'trap:+'} = 1;
	  close(LOOKUP_TABLE);
	  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(LOOKUP_TABLE);
	  return 1;
      }
  }# end of while loop;

    close(LOOKUP_TABLE);
    return 0;
}

# for convenience
sub ExactAddressMatch
{ 
    local($addr1, $addr2) = @_;
    &SaveACL;
    $ADDR_CHECK_MAX = 100; 
    local($r) = &AddressMatch($addr1, $addr2);
    &RetACL;
    $r;
}

# sub AddressMatching($addr1, $addr2)
# return 1 given addresses are matched at the accuracy of 4 fields
sub AddressMatching { &AddressMatch(@_);}
sub AddressMatch
{
    local($addr1, $addr2) = @_;

    &Debug("   AddressMatch($addr1, $addr2)".
	   " [\$ADDR_CHECK_MAX=$ADDR_CHECK_MAX]\n") if $debug_addrmatch;

    # 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) {
	if ($debug) {
	    &Debug("   AddressMatch($addr1, $addr2) => exact match");
	    &Log("AddressMatch($addr1, $addr2) => exact match");
	}
	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, $m) = (0, 0);
    while ($d1[$i] && $d2[$i] && ($d1[$i] eq $d2[$i])) { $i++;}

    $m = ($ADDR_CHECK_MAX > 0) ? $ADDR_CHECK_MAX : 3;

    if ($debug) {
	&Debug("   AddressMatch($acct1\@$addr1, $acct2\@$addr2) => ".
	       (($i >= $m) ? "match" : "not match").
	       " [$i >= $m ? y : n]");
	&Log("AddressMatch($acct1\@$addr1, $acct2\@$addr2) => ".
	     (($i >= $m) ? "match" : "not match"));
	&Log("AddressMatch: $i >= $m ? match : not match");
    }

    ($i >= $m) ? 1 : 0;
}

sub LowerDomain
{
    my ($addr) = @_;
    my (@addr) = split(/\@/, $addr);

    if ($DATABASE_DRIVER_ATTRIBUTES =~ /always_lower_domain/) {
	$addr[1] =~ tr/A-Z/a-z/;
	return $addr[0].'@'.$addr[1];
    }
    else {
	return $addr;
    }
}

####### Section: Info
# Recreation of the whole mail for error infomation
sub WholeMail { 
    local(@xargv) = @_; &use('kernsubr2'); &__WholeMail(@xargv);
}

sub ForwMail {
    local(@xargv) = @_; &use('kernsubr2'); &__ForwMail(@xargv);
}

sub Translate
{
    local(*e, $s, $mesgle_key, @mesgle_argv) = @_;
    if ($MESSAGE_LANGUAGE && $mesgle_key) {
	&use('mesgle');
	&MesgLE(*e, $mesgle_key, @mesgle_argv);
    }
    else { $NULL;}
}

# &Mesg(*e, );
# $mesgle == Message Languae Extension
sub Mesg 
{ 
    local(*e, $s, $mesgle_key, @mesgle_argv) = @_;

    if ($MESSAGE_LANGUAGE && $mesgle_key) {
	&Debug("MesgLE:try to translate key <$mesgle_key>") if $debug;
	&use('mesgle');
	$s = &MesgLE(*e, $mesgle_key, @mesgle_argv) || $s;
    }

    # if $s is null, return just now! (DUMMY_OPS may be useful)
    return unless $s;

    $e{'message'} .= "$s\n";
    $MesgBuf .= "$s\n";

    # dup to admins
    $e{'message:to:admin'} .= "$s\n" if $e{'mode:notify_to_admin_also'};
}

# no real data copy but 
# enable flag to mail body forwarding in Smtp() via Notify().
sub MesgMailBodyCopyOn
{
    &Mesg(*e, "Original mail as follows:\n");
    $Envelope{'message:ebuf2socket'} = 1;
}

sub MesgSetBreakPoint { undef $MesgBuf;} 
sub MesgGetABP { $MesgBuf;}	# After Break Point

# Forwarded and Warned to Maintainer;
sub Warn { &Forw(@_);}
sub Forw { &Sendmail($MAINTAINER, $_[0], $_[1]);}
sub WarnFile
{ 
    local($subject, $file, $preamble, $trailor) = @_;
    local($to, @file);

    @file = $file; undef $file;
    @to   = ($MAINTAINER);
    $Envelope{'preamble'} = $preamble;
    &NeonSendFile(*to, *subject,*file);
    undef $Envelope{'preamble'};
}

# Warn() with direct buffer copy from %Envelope to Socket
# and with "mh forwarding" separators (added in smtp library).
sub WarnF
{
    $Envelope{'ctl:smtp:forw:ebuf2socket'} = 1;
    &WarnE(@_);
    $Envelope{'ctl:smtp:forw:ebuf2socket'} = 0;
}

# Extended Warn() with direct buffer copy from %Envelope to Socket
sub WarnE
{
    local($subject, $body, $preamble, $trailor) = @_;
    local($title);

    $Envelope{'preamble'} = $preamble;

    $title = $Envelope{"tmp:ws"} || "Original mail as follows";
    $title = "\n$title:\n\n";

    $Envelope{'ctl:smtp:ebuf2socket'} = 1;
    &Sendmail($MAINTAINER, $subject, $body.$title);
    $Envelope{'ctl:smtp:ebuf2socket'} = 0;

    undef $Envelope{'preamble'};
}

sub Notify
{
    local(@xargv) = @_; 
    if ($debug) { my (@c) = caller; Log( "Notify: $c[1] $c[2]" ) ; }
    &use('kernsubr'); &__Notify(@xargv);
}

sub EnableReportForw2Admin
{ 
    local(*e) = @_; $e{'mode:notify_to_admin_also'} = 1;
}

sub DisableReportForw2Admin
{ 
    local(*e) = @_; $e{'mode:notify_to_admin_also'} = 0;
}

##
## Negative Cache Wrapper()'s
##
# wrap &Mesg() with negative cache
sub CMesg
{
    local($msgkey, $howold, *e, $s, $mesgle_key, @mesgle_argv) = @_;
    if (&OutOfNegativeCacheP($msgkey, $howold)) {
	&Mesg(*e, $s, $mesgle_key, @mesgle_argv);
    }
}

# wrap &Warn() with negative cache
sub CWarn
{
    local($msgkey, $howold, $subject, $body) = @_;
    if (&OutOfNegativeCacheP($msgkey, $howold)) {
	&Warn($subject, $body);
    }
}

sub OutOfNegativeCacheP
{
    local($msgkey, $howold) = @_;
    local($dir) = "$VAR_DIR/mesgcache";
    local($cf)  = "$dir/$msgkey";
    local($x);

    -d $dir || &Mkdir($dir);

    if (-f $cf) {
	$x = time - (stat($cf))[9]; # how lod  
	if ($x < $howold) { 
	    print STDERR "ignore now ($count, $x $howold)\n" if $debug;
	    return 0; # in negative cache
	}
    }

    &Touch($cf);

    1;
}

# Generate additional information for command mail reply.
# return the STRING
sub GenInfo
{
    local($s, $c, $d, $del);
    local($message, $has_ctladdr_p, $addr, $trap);

    # initialize variables
    $del     = ('*' x 60);

    # if has control-address
    if ($CONTROL_ADDRESS) {
	$addr = $Envelope{'CtlAddr:'};
	$has_ctladdr_p = 1;
    }
    # if !control-address but MAIL_LIST==CONTROL_ADDRESS
    elsif ((! $CONTROL_ADDRESS) && &CompatFMLv1P) { 
	$addr = $MAIL_LIST;
	$has_ctladdr_p = 1;
    }
    elsif ((! $CONTROL_ADDRESS) && $MAIL_LIST_ACCEPT_COMMAND) {
	$addr = $MAIL_LIST;
	$has_ctladdr_p = 1;
    }

    # help style;
    $message = $Envelope{"mode:fmlserv"} ? "help": "$Envelope{'trap:ctk'}help";
    if ($MAIL_LIST =~ /^(fmlserv|majordomo|listserv)/i) {
	$trap = '';
    }
    else {
	$trap = &CompatFMLv1P ? '#' : '';
    }

    $s .= "\n$del\n";

    # URL Extentions
    if ($ADD_URL_INFO) {
	if ($Envelope{'mode:stranger'}) {
	    $URLInfo = ";\n\t<mailto:$MAINTAINER>";
	    $URLComInfo = &GenXMLInfo;
	}
	# not stranger and has ctladdr (From: is a member).
	elsif ($has_ctladdr_p) {
	    $s .= "\n";
	    $s .= "       Help: <mailto:$addr?body=${trap}help>\n";
	    $s .= "Unsubscribe: <mailto:$addr?body=${trap}unsubscribe>\n";
	    $s .= "\n";

	    $URLInfo = ";\n\thelp=<mailto:$addr?body=${trap}help>";
	    $URLComInfo = &GenXMLInfo;
	}
	# not stranger and has no ctladdr (From: is a member).
	else {
	    $URLInfo = ";\n\t<mailto:$MAINTAINER>";
	}
    }

    # RFC2369; Proposed Standard (so fml optional)
    if ($USE_RFC2369) {
	&use('kernsubr2'); 
	&EmulRFC2369( {
	    'addr'  => $addr,
	    'trap'  => $trap,
	    'rcsid' => $Rcsid,
	});
    }

    $s .= "If you have any questions or problems,\n";
    $s .= "   please contact $MAINTAINER\n";

    if (! $Envelope{'mode:stranger'} && $has_ctladdr_p) { # a member
	$s .= "       or \n";
	$s .= "   send e-mail with the body \"$message\"(without quotes) to\n";
	$s .= "      $addr\n";
	$s .= "      (here is the automatic reply, so more preferable)\n\n";
	$s .= "e.g. on a Unix Machine\n";
	$s .= "(shell prompt)\% echo \"$message\" |Mail $addr";
    }

    $s .= "\n\n$del\n";

    $s;
}


sub GenXMLInfo
{
    if ($X_ML_INFO_MESSAGE) { 
	$X_ML_INFO_MESSAGE;
    }
    elsif ($Envelope{'mode:stranger'} ||
	   (!$CONTROL_ADDRESS && 
	      $PERMIT_POST_FROM =~ /^(anyone|members_only)$/)) {
	"If you have a question,\n\tplease contact $MAINTAINER".
	    ";\n\t<mailto:$MAINTAINER>";
    }
    else {
	"If you have a question, send e-mail with the body\n".
	    "\t\"". $Envelope{'trap:ctk'}.
		"help\" (without quotes) to the address ". &CtlAddr .
		$URLInfo;
    }
}

####### Section: IO
# Log: Logging function
# ALIAS:Logging(String as message) (OLD STYLE: Log is an alias)
# delete \015 and \012 for seedmail return values
# $s for ERROR which shows trace infomation
sub Logging { &Log(@_);}	# BACKWARD COMPATIBILITY
sub LogWEnv { local($s, *e) = @_; &Log($s); $e{'message'} .= "$s\n";}

sub Log 
{ 
    local($str, $s) = @_;
    local($package, $filename, $line) = caller; # called from where?
    local($from) = $PeerAddr ? "$From_address[$PeerAddr]" : $From_address;
    local($error);

    &GetTime;

    $str =~ s/\015\012$//; # FIX for SMTP (cut \015(^M));

    if ($debug_smtp && ($str =~ /^5\d\d\s/)) {
	$error .= "Sendmail ERROR:\n";
	$error .= "\t$Now $str $_\n\t($package, $filename, $line)\n\n";
    }

    $str = "$filename:$line% $str" if $debug_caller;

    # 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;
    }
    else {
	print STDERR "$Now ($package, $filename, $line) $LOGFILE\n";
	print STDERR "$Now $str ($from)\n\t$s\n";
    }

    $Envelope{'error'} .= $error if $error;

    print STDERR "*** $str; $s;\n" if $debug;
}

# $mode: see open(2) 
sub __Write30
{
    local(*e, *s, *f, $mode, $envelope_hash_key) = @_;
    local($status);
    
    if ($mode eq "O_APPEND") {
	$status = open(WRITE2_OUT, ">> $f");
    }
    else {
	$status = open(WRITE2_OUT, "> $f");
    }

    if ($status) {
	select(WRITE2_OUT); $| = 1; select(STDOUT);

	# XXX Caution: "\n" handling differs.
	if ($envelope_hash_key) {
	    print WRITE2_OUT $e{$envelope_hash_key};
	}
	else {
	    print WRITE2_OUT $s, "\n";
	}
	close(WRITE2_OUT);

	1;
    }
    else {
	0;
    }
}

sub HashValueAppend
{
    local(*e, $key, $f) = @_;

    &__Write30(*e, *NULL, *f, "O_APPEND", $key) || do {
	local(@caller) = caller;
	print STDERR "HashValueAppend(@_)::Error caller=<@caller>\n";
    };
}

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

    ($s && &__Write30(*NULL, *s, *f, "O_APPEND")) || do {
	local(@caller) = caller;
	print STDERR "Append2(@_)::Error caller=<@caller>\n";
    };
}

sub Write2
{
    local($s, $f, $o_append) = @_;

    if ($o_append) {
	return &Append2(@_);
    }
    elsif ($s && &__Write30(*NULL, *s, *f, "O_RWONLY")) {
	;
    }
    else {
	local(@caller) = caller;
	print STDERR "Write2(@_)::Error caller=<@caller>\n";
	return 0;
    };

    1;
}

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

sub Write3
{
    local(@xargv) = @_; &use('kernsubr'); &__Write3(@xargv);    
}

sub GetFirstLineFromFile 
{ 
    if (open(GFLFF, $_[0])) {
	chop($_ = <GFLFF>);
	close(GFLFF);
	$_;
    }
    else {
	return $NULL; 
    }
}

# $id = IncrementCounter(file, modulus)
sub IncrementCounter
{
    my ($f, $modulus) = @_;
    my ($id) = 0;

    # return cached id (against duplicated calls within one thread).
    $IncrementCounterCalled{$f}++;
    return $IncrementCounter{$f} if $IncrementCounterCached{$f};

    &Touch($f) unless -f $f;
    if (-f $f) {
	$id = &GetFirstLineFromFile($f);
	$id++;
	if ($modulus > 0) { $id = $id % $modulus;}
	if (open($f, "> ${f}.$$.new")) { 
	    select($f); $| = 1; select(STDOUT);
	    print $f $id, "\n"; 
	    close($f);
	    rename("${f}.$$.new", $f);
	}
    }
    $IncrementCounter{$f}       = $id; # (0 .. modulus-unit)
    $IncrementCounterCached{$f} = 1;
    $id;
}

# For Example, 
# $pp = $p = 0;
# while (1) { 
#   $p = &GetLinePtrFromHash(*Envelope, "Body", $pp);
#   print substr($Envelope{'Body'}, $pp, $p-$pp+1);
#   last if $p < 0; 
#   $pp = $p + 1;
# }
sub GetLinePtrFromHash
{
    local(*e, $key, $ptr) = @_;
    index($e{$key}, "\n", $ptr);
}

# For example,
# ($p, $pb, $pe) = &GetBlockPtrFromHash(*Envelope, 'Body', $b, $pp);
# last if $p < 0;
# print substr($Envelope{'Body'}, $pb, $pe - $pb);
sub GetBlockPtrFromHash
{
    local(*e, $key, $b, $ptr) = @_;
    local($p, $pb, $pe);
    $p  = &GetPtrFromHash(*e, 'Body', $b, $ptr);
    $pb = &GetPtrFromHash(*e, 'Body', "\n\n", $p + 1);
    $pe = &GetPtrFromHash(*e, 'Body', $b, $pb + 1);
    ($p, $pb + 2, $pe)
}

sub GetPtrFromHash
{
    local(*e, $key, $pat, $ptr) = @_;
    index($e{$key}, $pat, $ptr);
}

# useful for "Read Open"
sub Open
{
    if ((!-f $_[1]) || $_[1] eq '') {
	local(@c) = caller; local($c) = "$c[1],$c[2]"; $c =~ s#^\S+/##;
	if (! -f $_[1])  { &Log("${c}::Open $_[1] NOT FOUND");}
	if ($_[1] eq '') { &Log("${c}::Open $_[1] IS NULL; NOT DEFINED");}
	return 0;
    }
    open($_[0], $_[1]) || do { 
	local(@c) = caller; local($c) = "$c[1],$c[2]"; $c =~ s#^\S+/##;
	&Log("$c::Open failed $_[1]"); return 0;
    };
}

sub Copy
{
    local($in, $out) = @_;
    local($mode) = (stat($in))[2];
    open(COPYIN,  $in)      || (&Log("ERROR: Copy::In [$!]"), return 0);
    open(COPYOUT, "> $out") || (&Log("ERROR: Copy::Out [$!]"), return 0);
    select(COPYOUT); $| = 1; select(STDOUT);
    chmod $mode, $out;
    while (sysread(COPYIN, $_, 4096)) { print COPYOUT $_;}
    close(COPYOUT);
    close(COPYIN); 
    1;
}

# checks the executable "prog" in "prog option".
sub ProgExecuteP
{
    local($prog) = @_;

    $prog || return 0; # no input

    ($prog) = (split(/\s+/, $prog))[0];
    -x $prog ? 1 : 0;
}

# check fundamental programs existence
sub DiagPrograms
{
    my (@prog) = @_;
    my ($x, $bad);

    if ($UNISTD) {
	for $x (@prog) {
	    &ProgExecuteP( ${ $x } ) || do {
		$bad++;
		&Log("ERROR: program \$${x} is not defined");
	    };
        }
    }

    $bad ? 0 : 1; # if bad, return 0; 
}

# mainly search e.g. "sendmail"
sub SearchPath
{
    local($prog, @path) = @_;
    for ("/usr/sbin", "/usr/lib", @path) {
	if (-e "$_/$prog" && -x "$_/$prog") { return "$_/$prog";}
    }
}

sub SearchFileInLIBDIR
{
    for (@LIBDIR) { 
	&Debug("SearchFileInLIBDIR: <$_>/$_[0]") if $debug;
	if (-f "$_/$_[0]") { return "$_/$_[0]";}
    }
    $NULL;
}

sub SearchFileInINC
{
    for (@INC) { if (-f "$_/$_[0]") { return "$_/$_[0]";}}
    $NULL;
}

sub GetFirstMultipartBlock
{
    local(*e) = @_;

    if ($e{'MIME:boundary'}) {
	($p, $pb, $pe) = 
	    &GetBlockPtrFromHash(*e, 'Body', $e{'MIME:boundary'}, 0);	
	if ($pb > 0 && $pe > 0) { 
	    substr($e{'Body'}, $pb, $pe - $pb);
	}
	else {
	    &Log("GetFirstMultipartBlock: invalid MIME/multipart message");
	    $NULL;
	}
    }
    else {
	&Log("GetFirstMultipartBlock: invalid MIME/multipart message");
	$NULL;
    }
}

####### Section: Utilities
# we suppose &Uniq(*array)'s "array" is enough small.
sub Uniq
{
    local(*q) = @_;
    local(%p, @p);
    for (@q) { next if $p{$_}; $p{$_} = $_; push(@p, $_);}
    @q = @p;
}

# $pat is included in $list (A:B:C:... syntax)
sub ListIncludePatP
{
    local($pat, $list) = @_;
    for (split(/:/, $list)) { return 1 if $pat eq $_;}
    0;
}

sub DebugLog
{
    local($s) = @_;
    local($f) = $DEBUG_LOGFILE || $LOGFILE.".debug";
    &GetTime;
    &Append2("$Now $s", $f);
}

sub Debug 
{ 
    print STDERR "$_[0]\n";
    &Mesg(*Envelope, "\nDEBUG $_[0]") if $debug_message;
    &DebugLog($_[0]) if $debug > 1;
}

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

sub ATOI 
{
    if ($_[0] eq '') {
	return $NULL;
    }
    elsif ($_[0] =~ /^(\d+)$/i) {
	$_[0];
    }
    elsif ($_[0] =~ /^(\d+)M$/i) {
	 $1 * 1024 * 1024;
    }
    elsif ($_[0] =~ /^(\d+)K$/i) {
	$1 * 1024;
    }
    else {	
	&Log("ATOI: $_[0] is unknown type");
    }
}

# eval and print error if error occurs.
# which is best? but SHOULD STOP when require fails.
sub use { require "lib$_[0].pl";}
sub Use { require "lib$_[0].pl";}

# &UseModule("Japanese", "langdep");
sub UseModule { require "module/$_[0]/lib$_[1].pl";}

sub MkDir { &Mkdir(@_);}
sub Mkdir
{
    if ($_[1] ne '') { return &MkDirHier($_[0], $_[1]);}
    &MkDirHier($_[0], $DEFAULT_DIR_MODE || 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;
}

# eval and print error if error occurs.
sub eval
{
    &CompatFML15_Pre  if $COMPAT_FML15;
    eval $_[0]; 
    $@ ? (&Log("$_[1]:$@"), 0) : 1;
    &CompatFML15_Post if $COMPAT_FML15;
}

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

# Getopt
sub Opt { push(@SetOpts, @_);}
    
# Setting CommandLineOptions after include config.ph
sub SetOpts
{
    # should pararelly define ...
    for (@SetOpts) { 
	/^\-\-MLADDR=(\S+)/i && (&use("mladdr"),  &MLAddr($1));
	if (/^\-\-([_a-z0-9]+)$/||/^\-\-([_a-z0-9]+=\S+)$/) {&DEFINE_MODE($1);}
    }

    for (@SetOpts) {
	if (/^\-\-(force|fh):(\S+)=(\S+)/) { # "foreced header";
	    &DEFINE_FIELD_FORCED($2, $3); next;
	}
	elsif (/^\-\-(original|org|oh):(\S+)/) { # "foreced header";
	    &DEFINE_FIELD_ORIGINAL($2); next;
	}
	elsif (/^\-\-([_A-Z0-9]+)=(\S+)/) { # USER DEFINED VARIABLES
	    eval("\$$1 = '$2';"); next;
	}
	elsif (/^\-\-(\S+)/) {	# backward mode definition is moved above
	    local($_) = $1;
	    /^[_a-z0-9]+$/ || eval("\$${_} = 1;"); 
	    /^permit:([a-z0-9:]+)$/ && ($Permit{$1} = 1); # set %Permit;
	    next;
	}

	/^\-(\S)/      && ($Opt{"opt:$1"} = 1);
	/^\-(\S)(\S+)/ && ($Opt{"opt:$1"} = $2);

	/^\-d(\d+)/    && ($debug = $1)        && next;
	/^\-d|^\-bt/   && ($debug = 1)         && next;
	/^\-s(\S+)/    && &eval("\$$1 = 1;")   && next;
	/^\-u(\S+)/    && &eval("undef \$$1;") && next;
	/^\-l(\S+)/    && ($LOAD_LIBRARY = $1) && next;
    }
}

sub GenMessageId
{
    &GetTime;
    $GenMessageId = $GenMessageId++ ? $GenMessageId : 'AAA';
    "<${CurrentTime}.FML${GenMessageId}". $$ .".$MAIL_LIST>";
}
    
# which address to use a COMMAND control.
sub CtlAddr { &Addr2FQDN($CONTROL_ADDRESS);}

# Do FQDN of the given Address 1. $addr is set and has @, 2. MAIL_LIST
sub Addr2FQDN { $_[0]? ($_[0] =~ /\@/ ? $_[0]: $_[0]."\@$FQDN") : $MAIL_LIST;}
sub CutFQDN   { $_[0] =~ /^(\S+)\@\S+/ ? $1 : $_[0];}

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

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

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

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

    ($crc, $total);
}

sub LogFileNewSyslog
{
    $LOGFILE_NEWSYSLOG_LIMIT = &ATOI($LOGFILE_NEWSYSLOG_LIMIT);
    if ($LOGFILE_NEWSYSLOG_LIMIT) {
	if ((stat($LOGFILE))[7] > $LOGFILE_NEWSYSLOG_LIMIT) {
	    require 'libnewsyslog.pl'; 
	    &NewSyslog($LOGFILE);
	    &Touch($LOGFILE);
	}
    }
}

sub CacheTurnOver
{
    local($file, $size_limit) = @_;

    if ((stat($file))[7] > $size_limit) {
	&use('newsyslog');
	&NewSyslog'TurnOverW0($file);#';
	&Touch($file);
    }
}

sub DBCtl
{
    &use('db');
    &FML_SYS_DBCtl(@_);
}

####### Section: Security 
# anyway alias now (1998/05/03)
# If sent back directly, X-ML-Info: exists and must contains e.g. $MAIL_LIST .
sub MailLoopP
{
    if ($Envelope{'h:x-ml-info:'}) {
	my $error_count = 0;

	if ($MAINTAINER && $Envelope{'h:x-ml-info:'} =~ /contact $MAINTAINER/i) {
	    $error_count++;
	}
	elsif ($MAIL_LIST &&
	       $Envelope{'h:x-ml-info:'} =~ /(address\s+|mailto:)$MAIL_LIST/i) {
	    $error_count++;

	}
	elsif ($CONTROL_ADDRESS &&
	       $Envelope{'h:x-ml-info:'} =~ /(address\s+|mailto:)$CONTROL_ADDRESS/i) {
	    $error_count++;
	}

	if ($error_count) {
	    &Log("Loop Alert: dup X-ML-Info:");
	    &WarnE("Loop Alert: dup X-ML-Info: $ML_FN", 
		   "fml <$MAIL_LIST> has detected a loop condition so that\n"
		   ."input mail has already our ML X-ML-Info: field.\n\n");
	    return 1;
	}
    }

    &DupMessageIdP;
}

sub SearchDupKey
{
    local($key, $file) = @_;
    local($status, $i);

    # 1. scan current and 
    if (-f $file) { 
	$status = &Lookup($key, $file);
    }
    return $status if $status;

    # 2. scan all available caches
    for $i (0 .. $NEWSYSLOG_MAX) {
	if ($status) {
	    last; # end if non null $status is returned.
	}
	elsif (-f "$file.$i") {
	    $status = &Lookup($key, "$file.$i");
	}
    }

    $status;
}

# If O.K., record the Message-Id to the file $LOG_MESSAGE_ID);
# message-id cache should be done for mails in action
sub CacheMessageId
{
    local(*e, $msgid) = @_;
    local($id);

    # canonicalize
    $id = $msgid || $e{'h:Message-Id:'};
    $id || (&Log("Invalid Message-Id:<$id>"), return $NULL);
    $id =~ s/[\<\>]//g;
    $id =~ s/^\s+//;

    if ($CachedMessageID{$id}) {
	&Log("CacheMessageId: warning: duplicated input") if $debug_loop;
	return 0;
    }

    # Turn Over log file (against too big);
    # The default value is evaluated as "once per about 100 mails".
    &CacheTurnOver($LOG_MESSAGE_ID, 
		   $MESSAGE_ID_CACHE_BUFSIZE || 60*100);

    $CachedMessageID{$id} = 1;
    &Append2($id." \# pid=$$", $LOG_MESSAGE_ID);
}

sub DupMessageIdP
{
    local($status, $mid);

    # no check -> "return not looped"
    $CHECK_MESSAGE_ID || return 0;

    local($mid) = $Envelope{'h:Message-Id:'};
    $mid =~ s/[\<\>]//g; 
    $mid =~ s/^\s+//;

    &Debug("DupMessageIdP::($mid, $LOG_MESSAGE_ID)") if $debug;

    $status = &SearchDupKey($mid, $LOG_MESSAGE_ID);

    if ($status) {
	&Debug("\tDupMessageIdP::(DUPLICATED == LOOPED)") if $debug;
	local($s) = "Duplicated Message-ID";
	&Log("Loop Alert: $s");
	&WarnE("Loop Alert: $s $ML_FN", "$s in <$MAIL_LIST>.\n\n");
	1;
    }
    else {
	&Debug("\tDupMessageIdP::(OK NOT LOOPED)") if $debug;
	0;
    }
}

# if the addr to reply is O.K., return value is 1;
sub CheckAddr2Reply
{
    local(*e, @addr_list) = @_;
    local($addr, $m);
    my (@caller) = caller;

    ### 01: check recipients == myself?
    for $addr (@addr_list) {
	if (&LoopBackWarn($addr)) {
	    &Log("Notify: ERROR: the mail is not sent to $addr",
		 "since the addr to reply == ML or ML-Ctl-Addr");
	    &Log(@caller);
	    $m .= "\nNotify: ERROR: the mail is not sent to [$addr]\n";
	    $m .= "since the addr to reply == ML or ML-Ctl-Addr.\n";
	    $m .= "-" x60; $m .= "\n";
	}
	else {
	    print STDERR "CheckAddr2Reply 01: OK\t$addr\n" if $debug;
	}
    }

    ### 02: check the recipents
    for $addr (@addr_list) {
	if ($addr =~ /^($REJECT_ADDR)\@/i) {
	    $m .= "\nNotify: ERROR: the mail should not be sent to [$addr]\n";
	    $m .= "since the addr is not-personal or other agent softwares\n";
	    $m .= "-" x60; $m .= "\n";
	}
	else {
	    print STDERR "CheckAddr2Reply 02: OK\t$addr\n" if $debug;
	}
    }    

    # if anything happens, append the information;
    if ($m) {
	# append the original message and forwarding to the maintainer;
	$m .= "=" x60; $m .= "\n";
	$m .= "Original 'message' to send to the user:\n\n". $e{'message'};
	$m .= "=" x60; $m .= "\n";

	# message for the maintainer;
	$e{'error'} .= $m;
    }

    $m ? 0 : 1;	# if O.K., return 1;
}

# Check uid == euid && gid == egid
sub CheckUGID
{
    print STDERR "\nsetuid is not set $< != $>\n\n" if $< != $>;
    print STDERR "\nsetgid is not set $( != $)\n\n" if $( ne $);
    # die("YOU SHOULD NOT RUN fml AS ROOT NOR DAEMON\n") if $< == 0 || $< == 1;
}

sub GetGID { (getgrnam($_[0]))[2];}

sub InSecureP { (! &SecureP(@_));}

sub SecureP {
    local(@xargv) = @_; &use('kernsubr'); &__SecureP(@xargv);
}

sub ValidAddrSpecP
{
    ($_[0] !~ /\s|\033\$[\@B]|\033\([BJ]/ && 
     $_[0] =~ /^[\0-\177]+\@[\0-\177]+$/) ? 1 : 0;
}

# Check Looping 
# return 1 if loopback
sub LoopBackWarning { &LoopBackWarn(@_);}
sub LoopBackWarn
{
    local($to) = @_;
    local($a);
    local(@c) = caller;

    for $a ($MAIL_LIST, $CONTROL_ADDRESS, @MAIL_LIST_ALIASES, 
	    "fmlserv\@$DOMAINNAME", "majordomo\@$DOMAINNAME", 
	    "listserv\@$DOMAINNAME", "mead\@$DOMAINNAME") {

	next if $a =~ /^\s*$/oi;	# for null control addresses
	if (&AddressMatch($to, $a)) {
	    &Debug("AddressMatch($to, $a)") if $debug;
	    &Log("Loop Back Warning: ", "$to eq $a");
	    &Log("called from @c");
	    &WarnE("Loop Back Warning: [$to eq $a] $ML_FN", 
		   "Loop Back Warning: [$to eq $a]");
	    return 1;
	}
    }

    0;
}

sub RejectAddrP { 
    local(@xargv) = @_; &use('kernsubr'); &__RejectAddrP(@xargv);
}    

sub EnvelopeFilter {
    local(@xargv) = @_; &use('envf'); &__EnvelopeFilter(@xargv);
}

# QUOTA
sub CheckResourceLimit
{
    local(*e, $mode) = @_;

    if ($mode eq 'member') { 
	&use('amctl'); return &MemberLimitP(*e);
    }
    elsif ($mode eq 'mti:distribute:max_traffic') { 
	&MTIProbe(*MTI, $From_address, 'distribute:max_traffic');
    }
    elsif ($mode eq 'mti:command:max_traffic') { 
	&MTIProbe(*MTI, $From_address, 'command:max_traffic');
    }
}

####### Section: Macros for the use of user-side-definition (config.ph) 
### moved to "libloadconfig.pl"

####### Section: misc

# "get ID by auto-increment" for user 
sub GET_ID_AUTOINC
{
    local($f) = @_; 

    if (-f $f) { # Get the present ID
	local($id) = &GetFirstLineFromFile($f);
	$id++; 
	&Write2($id, $f);
	$id;
    }
    else {
	&Log("GET_ID_AUTOINC: cannot open $f");
	0;
    }
}

# Get Next MIME Multipart Block
sub GetNextMPBPtr
{
    local(*e, $ptr) = @_;
    local($pTop, $pEndHeader, $pBottom, $xbuf);
    
    if ($e{'MIME:boundary'}) {
	$pTop       = index($e{'Body'}, $e{'MIME:boundary'}, $ptr);
	$pEndHeader = index($e{'Body'}, "\n\n", $pTop);
	$pBottom    = index($e{'Body'}, $e{'MIME:boundary'}, $pEndHeader);
	($pTop, $pEndHeader, $pBottom);
    } else {
	&Log("GetNextMPBPtr: no MIME boundary definition");
	();
    }
}

# Get Next MIME Multipart Block
sub GetNextMultipartBlock
{
    local(*e, $ptr) = @_;
    local($pTop, $pEndHeader, $pBottom, $xbuf);
    
    if ($e{'MIME:boundary'}) {
	$pTop       = index($e{'Body'}, $e{'MIME:boundary'}, $ptr);
	$pEndHeader = index($e{'Body'}, "\n\n", $pTop);
	$pBottom    = index($e{'Body'}, $e{'MIME:boundary'}, $pEndHeader);

	if ($pEndHeader > 0 && $pBottom > 0) { 
	    $xhdr = substr($e{'Body'}, $pTop, $pEndHeader - $pTop);
	    $xbuf = substr($e{'Body'}, $pEndHeader, $pBottom - $pEndHeader);
	    ($xhdr, $xbuf, $pBottom)
	} else {
	    $NULL;
	}
    } else {
	&Log("GetNextMultipartBlock: no MIME boundary definition");
	$NULL;
    }
}

####### Section: Switch
sub SaveACL { $ProcCtlBlock{"main:ADDR_CHECK_MAX"} = $ADDR_CHECK_MAX;}
sub RetACL  { $ADDR_CHECK_MAX = $ProcCtlBlock{"main:ADDR_CHECK_MAX"};}

####### Section: Event Handling Functions
sub SignalLog 
{ 
    local($sig) = @_; 
    &Log("Caught SIG$sig, shutting down");
    sleep 1;
    exit(1);
}

# Strange "Check flock() OK?" mechanism???
# fml.pl exits under all cases after 12 hours (IT IS TOO LONG)!
sub Lock   
{ 
    &SetEvent($TimeOut{'dead'} || 43200, 'TimeOut') if $HAS_ALARM;

    # $LockQueueId is of mean under main locked phase
    # "mget" runs after $LockQueueId is cleared.
    $LockQueueId = &SetEvent($TimeOut{'lock'} || $TimeOut{'flock'} || 3600, 
			     'TimeOut') if $HAS_ALARM;
    $USE_FLOCK ? &Flock   : (&use('lock'), &V7Lock);
}

# for installer ?
sub ReloadMySelf
{
    # If myself is changed after exec'ed, reload it again.
    if ((-M __FILE__) < 0) {
	&Log("FYI: reload myself against installation");
	for ("libkern.pl", keys %INC) {
	    next unless /^lib\S+\.pl$|\/lib\S+\.pl$/;
	    delete $INC{$_};
	    &Log("reload $_ agasin against installation") if $debug;
	    require $_;
	}
    }
}

sub Unlock 
{ 
    $USE_FLOCK ? &Funlock : &V7Unlock;

    # $LockQueueId is of mean under main locked phase
    if ($LockQueueId) { &ClearEvent($LockQueueId);}
}

# lock algorithm using flock system call
# if lock does not succeed,  fml process should exit.
sub Flock
{
    local($min,$hour,$mday,$mon) = 
	(localtime(time + ($TimeOut{'flock'} || 3600)))[1..4];
    local($ut) = sprintf("%02d/%02d %02d:%02d", $mon + 1, $mday, $hour, $min);

    $FlockFile = $FlockFile ||
	(open(LOCK,$FP_SPOOL_DIR) ? $FP_SPOOL_DIR : "$DIR/config.ph");

    $0 = "${FML}: Locked(flock) until $ut <$MyProcessInfo>";

    # spool is also a file!
    if (! open(LOCK, $FlockFile)) {
	&Log("Flock:Cannot open FlockFile[$FlockFile]"); 
	die("Flock:Cannot open FlockFile[$FlockFile]"); 
    }
    flock(LOCK, $LOCK_EX);
}

sub Funlock 
{
    $0 = "${FML}: Unlock <$MyProcessInfo>";

    flock(LOCK, $LOCK_UN);
    close(LOCK); # unlock,close <kizu@ics.es.osaka-u.ac.jp>
}

# do not anything except for logging since now the fatal error case.
sub TimeOut
{
    &GetTime;
    $0 = "${FML}: TimeOut $Now <$MyProcessInfo>";

    # Now we may be not able to connect socket, isn't it?
    # &WarnE("TimeOut: $MailDate ($From_address) $ML_FN", $NULL);
    &Log("TimeOut[$$]: Caught SIGALRM, timeout");

    if ($TimeOutCalled++) {
	kill 9, $$;
    }
    else {
	$TimeOutCalled++;
	exit(0);
    }
}

sub SetEvent
{
    local($interval, $fp)  = @_;
    local($id, $now, $qp, $prev_qp);

    $now = time; # the current time;

    $id  = $EventQueue++ + 1; # unique identifier

    if ($interval < 60) {
	&Log("SetEvent: input interval[$interval] is too short. reset to 60");
	$interval = $interval < 60 ? 60 : $interval;
    }

    # the first reference is a dummy (without $fp);
    if ($id == 1) {
	$EventQueue{"time:${id}"} = $now;
	$EventQueue{"next:${id}"} = $id + 1;
	$id  = $EventQueue++ + 1; # unique identifier
    }

    # search the event queue for correct position; 
    # here search all entries;
    for ($qp = $EventQueue{"next:1"}, $prev_qp = 1; 
	 $qp ne ""; $qp = $EventQueue{"next:${qp}"}) {
	if ($EventQueue{"time:$qp"} >= $now + $interval) { last;}
	$prev_qp = $qp;
    }

    $EventQueue{"time:${id}"}  = $now + $interval;
    $EventQueue{"debug:${id}"} = $interval if $debug;
    $EventQueue{"fp:${id}"}    = $fp;

    # "next:id = null" if the next link does not exist.
    $EventQueue{"next:${prev_qp}"} = $id; # pointed to the current id;
    $EventQueue{"next:${id}"}      = $qp != $id ? $qp : ""; 

    &Tick; # tick(0);

    $id; # return the identifier;
}

sub ClearEvent
{
    local($id)  = @_;
    local($now, $qp, $prev_qp);

    # search the event queue for correct position;
    # here search all entries;
    for ($qp = $EventQueue{"next:1"};
	 $qp ne ""; 
	 $qp = $EventQueue{"next:${qp}"}) {

	if ($qp == $id) {
	    $EventQueue{"next:$prev_qp"} = $EventQueue{"next:$qp"};
	    &Debug("---ClearEvent: qp=$id fp=$EventQueue{\"fp:${id}\"}")
		if $debug;
	    &Log("ClearEvent: qp=$EventQueue{\"fp:$id\"}") if $debug_tick;
	    undef $EventQueue{"fp:$id"};
	    last;
	}
	$prev_qp = $qp;
    }
}

# ### ATTENTION! alarm(3) may conflict sleep(3); ###
# alarm(3) do actions as long as if needed;
# Plural functions may be done at the same time;
# but it is responsible Tick();
sub Tick
{
    local($cur, $fp, $qp);

    &GetTime; $0 = "${FML}: Tick $Now <$MyProcessInfo>";

    return unless $HAS_ALARM;

    print STDERR "===Tick called\n" if $debug;

    alarm(0); # before we sets in the routine, reset the current alarm; 
    $cur = time;

    # scan all entries and do the function (if time < the current_time);
    # so $qp (queue pointer) is set to the last action (< curret time)
    for ($qp = $EventQueue{"next:1"};
	 $EventQueue{"time:$qp"} <= $cur; 
	 $qp = $EventQueue{"next:${qp}"}) {

	$fp = $EventQueue{"fp:$qp"};
	next unless $fp;

	# $EventQueue{time:$qp} and alarm(3) time may be at the same time!
	undef $EventQueue{"fp:$qp"};
	&Log("Tick[$$]: run fp=$fp");
	eval("&$fp;");
	&Log($@) if $@;

	alarm(0);
	$cur = time;
    }

    $SIG{'ALRM'} = 'Tick'; 

    # info
    &Debug("\tnow\tqp=$qp fp=$EventQueue{\"fp:${qp}\"}") if $debug;

    # find the next $qp defined function pointer (time > cur_time)
    # skip null functions since the functions has been expireed.
    # *1 ignore $qp=0 case.
    for (; $qp && !$EventQueue{"fp:${qp}"}; $qp = $EventQueue{"next:${qp}"}) {
	;
    }
    &Debug("\tfinally\tqp=$qp fp=$EventQueue{\"fp:${qp}\"}") if $debug;

    $cur = $EventQueue{"time:${qp}"} - time;
    $cur = $cur > 0 ? $cur : 3;
    alarm($cur); # considering context switching;

    &Log("Tick[$$]::alarm($cur)") if $debug_tick;
    if ($debug) {
	&OutputEventQueue;
	&Debug("\tnow set alarm($cur) for the queue id $qp");
	&Debug("\tfp = $qp->$EventQueue{\"fp:${qp}\"}") if $debug_tick;
    }

    if ($debug_tick) {
	for ($qp = 1; $qp ne ""; $qp = $EventQueue{"next:${qp}"}) {
	    $cur = $EventQueue{"time:${qp}"} - time;
	    if ($cur >= 0) { # the future events list
		&Log(sprintf("  when=%-5d qp=%-2d link->%-2d fp=%s", 
			     $cur,
			     $qp, 
			     $EventQueue{"next:$qp"}, 
			     $EventQueue{"fp:$qp"}));
	    }
	}
    }
}

1;
### ---end of including 


### ---including #.include proc/libdebug.pl

# Copyright (C) 1993-1998 Ken'ichi Fukamachi
#          All rights reserved. 
#               1993-1996 fukachan@phys.titech.ac.jp
#               1996-1998 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: libdebug.pl,v 1.13 1999/10/26 16:58:32 fukachan Exp $

#### SIMULATION DEBUG #####

&Log("-------------------") if $0 =~ /\/fml.pl/;

# Debug Pattern Custom for &GetFieldsFromHeader
sub FieldsDebug
{
local($s) = q#"
PERMIT_POST_FROM     $PERMIT_POST_FROM
PERMIT_COMMAND_FROM  $PERMIT_COMMAND_FROM
REJECT_POST          $REJECT_POST_HANDLER
REJECT_COMMAND       $REJECT_COMMAND_HANDLER

FQDN                 $FQDN
DOMAIN               $DOMAINNAME

Mailing List         $MAIL_LIST
Return Path          $UnixFrom
From(Original):      $Envelope{'from:'}
From_address:        $From_address
Original Subject:    $Envelope{'subject:'}
To:                  $Envelope{'trap:rcpt_fields'}
Reply-To:            $Envelope{'h:Reply-To:'}
Addr2Reply:          $Envelope{'Addr2Reply:'}

DIR                  $DIR
LIBDIR               $LIBDIR
ACTIVE_LIST          $ACTIVE_LIST
\@ACTIVE_LIST        @ACTIVE_LIST
MEMBER_LIST          $MEMBER_LIST
\@MEMBER_LIST        @MEMBER_LIST

CONTROL_ADDRESS:     $CONTROL_ADDRESS
Do uip               $Envelope{'mode:uip'}
LOAD_LIBRARY         $LOAD_LIBRARY
"#;

"print STDERR $s";
}

sub OutputEventQueue
{
    local($qp);

    &Debug("---Debug::OutputEventQueue();");
    for ($qp = 1; $qp ne ""; $qp = $EventQueue{"next:${qp}"}) {
	&Debug(sprintf("\tqp=%-2d link->%-2d fp=%s",
		       $qp, $EventQueue{"next:$qp"}, $EventQueue{"fp:$qp"}));
    }
}


### logs STDIN (== mail imports itself);
sub StdinLog
{
    local($date) = sprintf("%04d%02d%02d", 1900 + $year, $mon + 1, $mday);
    local($f)    = "$VARLOG_DIR/STDIN_LOG_$date";

    &HashValueAppend(*Envelope, "Header", $f);
    &Append2("\n", $f);
    &HashValueAppend(*Envelope, "Body", $f);
}


### memory trace 
sub MTrace
{
    for (ADMIN_COMMAND_HOOK,
	 AUTO_REGISTRATION_HOOK,
	 COMMAND_HOOK,
	 DISTRIBUTE_CLOSE_HOOK,
	 DISTRIBUTE_START_HOOK,
	 FML_EXIT_HOOK,
	 HEADER_ADD_HOOK,
	 HTML_TITLE_HOOK,
	 HTML_TITLE_HOOK,
	 MODE_BIFURCATE_HOOK,
	 MSEND_HEADER_HOOK,
	 MSEND_OPT_HOOK,
	 MSEND_START_HOOK,
	 REPORT_HEADER_CONFIG_HOOK,
	 RFC1153_CUSTOM_HOOK,
	 SMTP_CLOSE_HOOK,
	 SMTP_OPEN_HOOK,
	 START_HOOK) {
	eval("\$$_ .= q#&MStat;#");
    }
}

package fmldebug;
sub main'MStat #";
{
    local($xpkg, $xfile, $xln) = @_;
    local($pkg, $file, $ln) = caller;
    $file =~ s#.*/##;

    open(STAT, "ps -u -p $$|"); 
    while (<STAT>) { 
	next if /USER/;
	chop;

	@x = split;
	$p = $x[4] - $px[4];
	$q = $x[5] - $px[5];
	$px[4] = $x[4];
	$px[5] = $x[5];
	print STDERR "--- xpkg=$xpkg pkg=$pkg\n" if $debug; 
	printf STDERR "%1s %4d\t%4d  sum=<%4d %4d> (%s:%d %s:%d)\n", 
	($touch ? "+" : ""), $p, $q, $x[4], $x[5], 
	$xfile, $xln, $file, $ln;
    }
    close(STAT); 

    $touch++;
}

1;
### ---end of including 





############################################################
##### Built-In Functions
############################################################
#.USAGE: sendback
#.USAGE:     ÆâÉôÄêµÁ´Ø¿ô¤È¤·¤Æ¤Ï &sendback(¥Õ¥¡¥¤¥ë) ¤Ï
#.USAGE:     ¥Õ¥¡¥¤¥ë ¤òÁ÷¤êÊÖ¤·¤Þ¤¹
#.USAGE:     °ú¿ô¤Ê¤·¤Ë sendback ¤ò»È¤¦¤È
#.USAGE:        e.g. .fmllocalrc ¤Ç from uja & sendback
#.USAGE:     Àµµ¬É½¸½¤Ç¥Þ¥Ã¥Á¤·¤¿Âè°ì¥Õ¥£¡¼¥ë¥É¤Î¥Õ¥¡¥¤¥ë¤òÁ÷¤êÊÖ¤¹
#.USAGE:     .fmllocalrc¤ÎÎã:
#.USAGE:     subject get (\S+) & sendback
#.USAGE: 
sub sendback
{
    local($file, $fullpath) = @_;
    $file = $file || $F1;
    local($to)   = $Reply_to ? $Reply_to : $From_address;
    local($ok)   = 1;
    local($dir)  = $ARCHIVE_DIR;

    if (! $fullpath) {
	chdir $dir || (&Log("cannot chdir $dir, STOP!"), undef $ok);
    }
    elsif ($fullpath) {
	undef $dir;
    }

    if ($ok && -f $file) {
	&Log("sendback $dir/$file");
	&SendFile($to, "Send $file", $file);
    }
    else {
	$s  = "I cannot find $file\n\n";
	$s .= "If you have a problem\n";
	$s .= "please contact $MAINTAINER\n";
	&Sendmail($to, "Cannot find $file", $s);
	&Log("cannot find $dir/$file");
    }

    1;
}


#.USAGE: getmyspool_nopasswd
#.USAGE:     ¥á¡¼¥ë¥¹¥×¡¼¥ë¤òÁ÷¤êÊÖ¤·¤Þ¤¹
#.USAGE:     ¥Ñ¥¹¥ï¡¼¥É¤ÏÉ¬Í×¤¢¤ê¤Þ¤»¤ó¡£
#.USAGE:     ÆâÉôÄêµÁ´Ø¿ô¤È¤·¤Æ»È¤¦¤Ù¤­¤Ç¤¹
#.USAGE: 
sub getmyspool_nopasswd
{
    undef $F1; undef $F2; undef $F3;
    &Log("getmyspool");
    &sendback($MAIL_SPOOL, 1);
}


#.USAGE: getmyspool 
#.USAGE:     ¥á¡¼¥ë¥¹¥×¡¼¥ë¤òÁ÷¤êÊÖ¤·¤Þ¤¹
#.USAGE:     Àµµ¬É½¸½¤Ç¥Þ¥Ã¥Á¤·¤¿Âè°ì¥Õ¥£¡¼¥ë¥É¤ò¥Ñ¥¹¥ï¡¼¥É¤È¤·¤ÆÇ§¾Ú¤·¤Þ¤¹
#.USAGE:     Ç§¾Ú¤·¤¿¾ì¹ç Á÷¤êÊÖ¤·¤Þ¤¹¡£
#.USAGE:    .fmllocalrc¤ÎÎã:
#.USAGE:    body get my spool (\.*) & getmyspool
#.USAGE:
sub getmyspool
{
    if ($F1 eq $PASSWORD) {
	&getmyspool_nopasswd;
    }
    else {
	&Log("ILLEGAL PASSWORD [$F1] != [$PASSWORD]");
    }
}

#.USAGE: getmyspool2
#.USAGE:     ¥á¡¼¥ë¥¹¥×¡¼¥ë¤òÁ÷¤êÊÖ¤·¤Þ¤¹
#.USAGE:     Àµµ¬É½¸½¤Ç¥Þ¥Ã¥Á¤·¤¿
#.USAGE:            Âè£±¥Õ¥£¡¼¥ë¥É¤ò¥Ñ¥¹¥ï¡¼¥É¤È¤·¤ÆÇ§¾Ú¤·¤Þ¤¹
#.USAGE:            Âè£²¥Õ¥£¡¼¥ë¥É¤òÇÛÁ÷¤Î¥â¡¼¥É¤È¤·¤Æ»È¤¤¤Þ¤¹¡£
#.USAGE:            Âè£²¥Õ¥£¡¼¥ë¥É¤¬¤Ê¤¤¤È¤­¤Ïspool¤Î¥Õ¥¡¥¤¥ë¤Î·Á¤Î¤Þ¤Þ¤Ç¤¹¡£
#.USAGE:    
#.USAGE:    .fmllocalrc¤ÎÎã:
#.USAGE:    body getmyspool\s+(\S+)\s+(.*) & getmyspool2
#.USAGE:    body getmyspool password mode & getmyspool2
#.USAGE:    
#.USAGE:    e.g.
#.USAGE:    echo getmyspool password uf |Mail (Âç³Ø|²ñ¼Ò)¤Î¥¢¥É¥ì¥¹ 
#.USAGE: 
#.USAGE:    »È¤¨¤ë¥â¡¼¥É(Âè£²¥Õ¥£¡¼¥ë¥É)¤Ï
#.USAGE:                »ØÄê¤·¤Ê¤¤¤È¤­¤Ï uf ¤ËÀßÄê
#.USAGE: 	uf	PLAINTEXT(UNIX FROM)
#.USAGE:    	tgz	tar+gzip ¤Ç spool.tar.gz
#.USAGE: 	gz	GZIP(UNIX FROM)
#.USAGE: 	b	lha + ish 
#.USAGE: 	ish	lha + ish 
#.USAGE: 	rfc934	RFC934 format 	PLAINTEXT
#.USAGE: 	unpack	PLAINTEXT(UNIX FROM)
#.USAGE: 	uu	UUENCODE
#.USAGE: 	d	RFC1153 format 	PLAINTEXT
#.USAGE: 	rfc1153	RFC1153 format 	PLAINTEXT
#.USAGE: 
#.USAGE:     ¡ö¡ö¡öÃí°Õ¡ö¡ö¡ö
#.USAGE:     libutils.pl ¤ò»È¤¦¤Î¤Ç¡¢¤³¤Î¥Õ¥¡¥¤¥ë¤ÎDirectory¤ò
#.USAGE:     .fmllocalrc ¤Ç 
#.USAGE:     INC Directory 
#.USAGE:     ¤Î¤è¤¦¤Ë½ñ¤¤¤Æ¤¯¤À¤µ¤¤¡ÊINC=include-path¡Ë
#.USAGE: 
#.USAGE:     ¤½¤ì¤«¤é¡¢°µ½ÌÅù¤Î¤¿¤á¤Ë¤Ï¥·¥¹¥Æ¥à¤Î¥³¥Þ¥ó¥É¤ò»È¤¤¤Þ¤¹¡£
#.USAGE:     fmlËÜÂÎ¤Ç¤Ï¥¤¥ó¥¹¥È¡¼¥ë¥×¥í¥°¥é¥à¤¬¼«Æ°Åª¤ËÃµ¤·¤Þ¤¹¤¬¡¢
#.USAGE:     fml_local ¤Î¤ß¤ò»È¤¦¾ì¹ç¤Ï¤³¤ì¤é¤ÎÀßÄê¤ò¤·¤Æ¤¯¤À¤µ¤¤¡£
#.USAGE: 
#.USAGE:     Îã: .fmllocalrc ¤Ë COMPRESS /usr/local/bin/gzip -c
#.USAGE:         ¤Î¤è¤¦¤Ë¤Ç¤¹¡£
#.USAGE: 
#.USAGE:	$TAR		= "/usr/local/bin/tar cf -";
#.USAGE:	$UUENCODE	= "/bin/uuencode";
#.USAGE:	$RM		= "/sbin/rm -fr";
#.USAGE:	$CP		= "/bin/cp";
#.USAGE:	$COMPRESS	= "/usr/local/bin/gzip -c";
#.USAGE:	$ZCAT		= "/usr/local/bin/zcat";
#.USAGE: 
#.USAGE:    ¡ö¼«Ê¬¤Ç¼«Æ°Åª¤ËÃµ¤¹¤è¤¦¤Ë¤â¤Ç¤­¤ë¤±¤É´í¸±¤À¤«¤é¤·¤Ê¤¤
#.USAGE: 
sub getmyspool2
{
    umask(077);		       
    require 'libfop.pl';

    local($d, $mode, $tmpf, $tmps, $to);

    $MAIL_LENGTH_LIMIT = $MAIL_LENGTH_LIMIT || 2850;

    $mode       = $F2 || 'uf';
    ($d, $mode) = &ModeLookup("3$mode");
    $to         = $Envelope{'Addr2Reply:'};

    # ($f, $mode, $subject, @to)
    &SendFilebySplit($MAIL_SPOOL, $mode, 'getmyspool2', $to);
}



#.USAGE: forward
#.USAGE:     ¥á¡¼¥ë¤òÆÃÄê¤Î¥¢¥É¥ì¥¹¤Ø¥Õ¥©¥ï¡¼¥É¤¹¤ë
#.USAGE:     ¥¢¥É¥ì¥¹¤Ï forward ¤Î¸å¤Ë¶õÇò¤ÇÂ³¤±¤Æ 
#.USAGE:     \@OPT ¤ÎÃæ¤ËÆþ¤Ã¤Æ¤Þ¤¹¡£
#.USAGE:     ´ÊÃ±¤Ê¥á¡¼¥ê¥ó¥°¥ê¥¹¥È¤Ç¤¹¤Í
#.USAGE:    .fmllocalrc¤ÎÎã:
#.USAGE:    To (uja) & forward address-1 address-2 ..
#.USAGE:        or
#.USAGE:    file ¤ÎÃæ¤Ë¥¢¥É¥ì¥¹¤¬½ñ¤¤¤Æ¤¢¤ë¡Ê°ì¹Ô°ì¥¢¥É¥ì¥¹¡Ë¾ì¹ç
#.USAGE:    To (uja) & forward :include:file
#.USAGE: 
sub forward
{
    local($host) = 'localhost';
    local($body, @rcpt, $status);
    &Log("Forward");

    # :include: form
    if ($OPT[0] =~ /^:include:(\S+)/) {
	$file = $1;
	undef @OPT;
	open(F, $file) || (&Log("cannot open $file"), return);
	while (<F>) {
	    chop;
	    next line if /^\#/o;	# skip comment and off member
	    next line if /^\s*$/o;	# skip null line
	    push(@OPT, $_);	    
	}
	close(F);
    }

    &SetDefaults;
    &GetTime;

    for (@HdrFieldsOrder) {
	$Envelope{'Hdr'} .= "$_: $Envelope{\"h:$_:\"}\n" if $Envelope{"h:$_:"};
    }

    $Envelope{'Hdr'} .= "X-FML-LOCAL: ENFORCE MAIL.LOCAL\n";
    $Envelope{'Hdr'} .= "X-MLServer: $rcsid\n" if $rcsid;
    $Envelope{'Hdr'} .= "Precedence: ".($PRECEDENCE || 'list')."\n"; 

    foreach $rcpt (@OPT) { push(@rcpt, $rcpt);}

    $status = &Smtp(*Envelope, *rcpt);
    &Log("Sendmail:$status") if $status;
}

#.USAGE: discard
#.USAGE:   ²¿¤â¤·¤Ê¤¤¡£¥À¥ß¡¼´Ø¿ô ¡á¡á ÆþÎÏ¤ò¼Î¤Æ¤ë´Ø¿ô¤È¤â¤¤¤¦
#.USAGE:    .fmllocalrc¤ÎÎã:
#.USAGE:    From    (uja)      & discard
#.USAGE:    Í×¤¹¤ë¤Ë
#.USAGE:    From    (uja)      > /dev/null
#.USAGE:    ¤ÈÆ±¤¸¤Ç¤¹¤Í¡Á
#.USAGE: 
sub discard{ 1;}

#.USAGE: 
#.USAGE: ALIASES:
#.USAGE: getback       ¤Ï sendback ¤ÈÆ±¤¸
#.USAGE: 
sub getback { &sendback(@_);}

#.USAGE: getmyspool_pw ¤Ï getmyspool ¤ÈÆ±¤¸
#.USAGE: 
sub getmyspool_pw { &getmyspool(@_);}

1;
