#! @PERL@

#  NEWDB processor in all wraps..
#

# -----------------------------------------------------------------------
#    newdbprocessor()  -- converts DB configuration to ZMSH scripts
#                         which the router digests at its startup.
#
#|Fields:
#|     relation-name
#|         dbtype(,subtype)
#|              dbpriv control data (or "-")
#|                  newdb_compile_options (-a for aliases! -r = read-only)
#|                     dbfile (or "-")
#|                         dbflags (or "-") ... (until end of line)
#|
#| The 'relation-name' are a set of magic tokens (listed below), which
#| system scripts support.  There can be any number of databases for
#| any given 'relation-name'.  Those are scanned in order, first match
#| wins.  (E.g. you can have multiple 'aliases' relations.)
#|
#| The  dbtype  can be "magic" '$DBTYPE', or any other valid database
#| type for the Router.  Somewhat magic treatment (newdb runs) are
#| done when the dbtype is any of: *DBTYPE/dbm/gdbm/ndbm/btree
#|
#| The  newdb_compile_options  are used when recompiling the database
#| with 'newdb' command.
#|
#| The "dbfile" need not be located underneath of $MAILVAR, as long as
#| it is in system local filesystem (for performance reasons.)  E.g.
#| one can place one of e.g. aliases files to some persons directory.
#| Implicite assumption is, that the 'newdb' produces the database
#| with same name, as what the "dbfile" fields says -- appending only
#| database type specific magic tail(s).
#|
#| At  dbflags  (until end of the line), characters ':' and '%' have special
#| meaning as their existence generates lookup routines which pass user's
#| optional parameters.  See documentation about 'dblookup'.
#|
#|
#|Example:
#|
#|Security sensitive ones ("dbpriv" must be defined!)
#| aliases         $DBTYPE  0:0:644    -la $MAILVAR/db/aliases        -lm
#| aliases         $DBTYPE  root:0:644 -la $MAILVAR/db/aliases-2      -lm
#| fqdnaliases     $DBTYPE  root:0:644 -la $MAILVAR/db/fqdnaliases    -lm
#| fqdnroutes      $DBTYPE  root:0:644 -la $MAILVAR/db/fqdnroutes     -lm%:
#| userdb          $DBTYPE  root:0:644 -l  $MAILVAR/db/userdb         -lm
#|
#|Security insensitive ones ("dbpriv" need not be defined!)
#| fqdnaliasesldap ldap   -  -   $MAILVAR/db/fqdnalias.ldap -lm -e 2000 -s 9000
#| fullnamemap     $DBTYPE  -    -l  $MAILVAR/db/fullnames    -lm
#| mboxmap         $DBTYPE  -    -l  $MAILSHARE/db/mboxmap    -lm
#| expired         $DBTYPE  -    -l  $MAILVAR/db/expiredaccts -lm
#| iproutesdb      $DBTYPE  -    -l  $MAILVAR/db/iproutes     -lmd longestmatch
#| routesdb        $DBTYPE  -    -l  $MAILVAR/db/routes       -lm%:d pathalias
#| thishost        $DBTYPE  -    -l  $MAILVAR/db/localnames   -lm%d  pathalias
#| thishost        unordered -   -   $MAILVAR/db/localnames   -ld    pathalias
#| thishost        bind,mxlocal - -  -                        -ld    pathalias
#| otherservers    unordered -   -   $MAILVAR/db/otherservers -lmd   pathalias
#| newsgroup       $DBTYPE  -    -l  $MAILVAR/db/active       -lm

# --------------------

sub pick_zenv {

    my ($ZCONFIG) = @_;

    open(ZZ, "< ".$ZCONFIG) || die "No ZCONFIG file at '$ZCONFIG'";
    while (<ZZ>) {
	chomp;
	local($n,$l) = split(/=/,$_,2);
	$ZENV{$n} = $l  if ($n =~ m/^[A-Z0-9a-z]/);
    }
    close(ZZ);
}

# ---------------------

$infn = $ARGV[0];

%ZENV = ();
%rels = ();
@inps = ();

select STDOUT; $| = 1;

$ZCONFIG = '@ZMAILERCFGFILE@';
$ZCONFIG = $ENV{'ZCONFIG'} if (defined $ENV{'ZCONFIG'});

& pick_zenv( $ZCONFIG);

$ENV{'PATH'} = "$ZENV{'MAILBIN'}:$ENV{'PATH'}";
$ENV{'MAILVAR'} = $ZENV{'MAILVAR'};
$ENV{'MAILBIN'} = $ZENV{'MAILBIN'};
$ENV{'MAILSHARE'} = $ZENV{'MAILSHARE'};

$DBTYPE = $ZENV{'DBTYPE'};


open(INFN, "< ".$infn) || die "Can't open file '$infn' for reading";

#
# Collect all relation names, and lines with them for later processing
#
while (<INFN>) {

	next unless(m/^[0-9a-zA-Z]/);
	chomp;
	($rname,$rest) = split(' ',$_,2);
	$rels{$rname} = 1;
	push @inps, $_;

}
close(INFN);


chdir ($ZENV{'MAILVAR'}.'/db') || die "Can't chdir($ZENV{'MAILVAR'}/db) ??";

printf("( ");

foreach $rel (keys %rels) {

    printf "${rel}{";

    $ofn="${rel}.zmsh";
    @ofn=();
    $rnum=1;
    @tnf=(); # trunc the "file"

    $oo='';
    # --- construct each relation, and binding at lookup, generate the db
    foreach $inp (@inps) {
	($rname,$rtype,$rpriv,$rndbopt,$rdbfile,$rdbflags) = split(' ',$inp,6);
	next unless ( $rel eq $rname );

	$rn="${rel}_$rnum";
	$rnum = $rnum +1;

	$rdbext    = '';
	$rdbtype   = '';
	$rdbexttst = '';

	# Process options into what the newdb really likes to get..
	if ($rndbopt eq '-') {
	    $rndbopt = '';
	} elsif ($rndbopt eq '-l') {
	    $rndbopt = '-l';
	} elsif ($rndbopt eq '-la') {
	    $rndbopt = '-l -a';
	}

	eval {$fn = "$rdbfile"; };
	printf "$oo$rn";
	$oo=',';
	local(@dbfiles) = ();
	if ($rtype =~ m/.*DBTYPE/o) {
		$rdbexttst = '$DBEXTtest';
		$rdbext    = '$DBEXT';
		$rdbtype   = '$DBTYPE';
		if ($rndbopt ne '-r') {
		    system("newdb -s $rndbopt -t $DBTYPE $fn");
		}
		printf ":NEW";
		if ($DBTYPE eq 'ndbm') {
			@dbfiles = ($fn.".pag", $fn.".dir");
		} elsif ($DBTYPE eq 'dbm') {
			@dbfiles = ($fn.".pag", $fn.".dir");
		} elsif ($DBTYPE eq 'gdbm') {
			@dbfiles = ($fn.".gdbm");
		} elsif ($DBTYPE eq 'bhash') {
			@dbfiles = ($fn.".dbh");
		} elsif ($DBTYPE eq 'btree') {
			@dbfiles = ($fn.".db");
		# } else {
			# LDAP/BIND/ORDERED/UNORDERED/INCORE ...
		}
	} elsif ($rtype eq 'NONE') {
		$rdbexttst = '';
		$rdbtype   = 'NONE';
	} elsif ($rtype eq 'ndbm') {
		$rdbexttst = '.pag';
		$rdbtype   = $rtype;
		if ($rndbopt ne '-r') {
		    system("newdb -s $rndbopt -t ndbm $fn");
		}
		printf ":NEW";
		@dbfiles = ($fn.".pag", $fn.".dir");
	} elsif ($rtype eq 'dbm') {
		$rdbexttst = '.pag';
		$rdbext    = '';
		$rdbtype   = $rtype;
		if ($rndbopt ne '-r') {
		    system("newdb -s $rndbopt -t  dbm $fn");
		}
		printf ":NEW";
		@dbfiles = ($fn.".pag", $fn.".dir");
	} elsif ($rtype eq 'sdbm') {
		$rdbexttst = '.pag';
		$rdbext    = '';
		$rdbtype   = $rtype;
		if ($rndbopt ne '-r') {
		    system("newdb -s $rndbopt -t sdbm $fn");
		}
		printf ":NEW";
	} elsif ($rtype eq 'gdbm') {
		$rdbexttst = '.gdbm';
		$rdbext    = '.gdbm';
		$rdbtype   = $rtype;
		if ($rndbopt ne '-r') {
		    system("newdb -s $rndbopt -t gdbm $fn");
		}
		printf ":NEW";
		@dbfiles = ($fn.".sdbm");
	} elsif ($rtype eq 'btree') {
		$rdbexttst = '.db';
		$rdbext    = '.db';
		$rdbtype   = $rtype;
		if ($rndbopt ne '-r') {
		    system("newdb -s $rndbopt -t btree $fn");
		}
		printf ":NEW";
		@dbfiles = ($fn.".db");
	} elsif ($rtype eq 'bhash') {
		$rdbexttst = '.dbh';
		$rdbext    = '.dbh';
		$rdbtype   = $rtype;
		if ($rndbopt ne '-r') {
		    system("newdb -s $rndbopt -t bhash $fn");
		}
		printf ":NEW";
		@dbfiles = ($fn.".dbh");
	} elsif ($rtype eq 'ldap') {
		$rdbexttst = '';
		$rdbext    = '';
		$rdbtype   = $rtype;
		@dbfiles = ($fn);
	} elsif ($rtype eq 'unordered') {
		$rdbexttst = '';
		$rdbext    = '';
		$rdbtype   = $rtype;
		@dbfiles = ($fn);
	} elsif ($rtype eq 'ordered') {
		$rdbexttst = '';
		$rdbext    = '';
		$rdbtype   = $rtype;
		@dbfiles = ($fn);
	} elsif ($rtype =~ '^bind[,/]') { # Has subtypes
		$rdbexttst = '';
		$rdbext    = '';
		$rdbtype   = $rtype;
		@dbfiles = ($fn);
	} elsif ($rtype =~ '^yp[,/]') { # Has subtypes
		$rdbexttst = '';
		$rdbext    = '';
		$rdbtype   = $rtype;
		@dbfiles = ($fn);
	} elsif ($rtype eq 'incore') {
		$rdbexttst = '';
		$rdbext    = '';
		$rdbtype   = $rtype;
		@dbfiles = ($fn);

		if ($rdbfile ne '-') {

		    ##
		    ## Convert input file ($fn) into incore format, store
		    ## the data into the @ofn array (after 'relation') with
		    ## 'pushd(@ofn, "db add relname keyname \"value\"")'
		    ##

		    if (open(RDBFILE, "< ". $rdbfile)) {
			while (<RDBFILE>) {
			    chomp;
			    next if (m/^[ \t]*\#/o);  # Comment line
			    next if (m/^[ \t]*\$/o);  # Blank line

			    local($key,$data) = split(' ', $_, 2);

			    $key  =~ s{\\}{\\\\}go; # Double backslashes
			    $key  =~ s{"}{\\"}go;   # Backslash quotes
			    $data =~ s{\\}{\\\\}go;
			    $data =~ s{"}{\\"}go;

			    pushd(@ofn, 'db add '.$rel.' "'.$data.'"');
			}
			close(RDBFILE);
		    }

		}

	} else {
		$rdbexttst = '.dat';
		$rdbext    = '.dat';
	}

	local($optset) = ' $o1 $o2 $o3 $o4 $o5 $o6 $o7 $o8 $o9 $o10 $o11 $o12 $o13 $o14 $o15 $o16 $o17 $o18 $o19';
	if ((!($rdbflags =~ /:/)) &&
	    (!($rdbflags =~ /\%/))) {
	    $optset = '';
	}

	if ($rtype ne 'NONE') {


	    if ($rdbfile eq '-') {
		unshift(@ofn, "	relation $rdbflags -t $rtype $rn");
	    } else {
		unshift(@ofn, "	relation $rdbflags -t $rtype -f $rdbfile$rdbext $rn");
	    }

	    if ($rpriv eq '-') {
		# ---- No privilege things collected -----
		push(@tfn,
"	if a=\"\$($rn \$key ".$optset.")\"; then
	    returns \"\$a\"
	fi");

	    } else {
		# ---- privilege things to collect ----
		# rpriv is a colon separated duplet/triplet:

		local(@priv) = split(/:/,$rpriv);
		local($fmask) = '644';

		if (defined $priv[1] && @dbfiles) {
		    local($pw0,$pw1,$pw2,$pw3) = getpwnam($priv[0]);
		    local($gr0,$gr1,$gr2,$gr3) = getgrnam($priv[1]);
		    $priv[0] = $pw2 if (defined $pw2);
		    $priv[1] = $gr2 if (defined $gr2);

		    chown $priv[0],$priv[1], @dbfiles;
		}
		if (defined $priv[2] && @dbfiles) {
		    $fmask = $priv[2];
		    chmod oct($priv[2]), @dbfiles;
		}

		push(@tfn,
"	if a=\"\$($rn \$key ".$optset.")\"; then
	    priv=\"\$(filepriv -M $fmask $rdbfile$rdbexttst \\
			    \$(db owner $rn))\" &&
	    returns \"\$a\"
	fi");
	    }
	}
    } # --- foreach $inp (@inps) ....


    # --- put out head..
    unshift(@ofn,  "# ZMSH init script for relation: ${rel}",
		    "",
		    "# ---boilerplate head" );

    # --- put out tails, and complete..
    push(@ofn, "# boilerplate tail---

${rel}(key, o1, o2, o3, o4, o5, o6, o7, o8, o9, o10, o11, o12, o13, o14, o15, o16, o17, o18, o19) {
    local a");

    push(@ofn, @tfn);
    @tfn = ();

    push(@ofn, "    return 1
}");

    open(OFN, "> $ofn") || die "Can't open '$ofn' for writing!";

    foreach $inp (@ofn) {
	printf OFN "%s\n", $inp;
    }

    close (OFN);

    printf "} ";

} # -- foreach $rel (keys %rels) ...

printf ") ";

exit (0);

1;