#! /usr/bin/perl

#  NEWDB processor in all wraps..
#
# FIXME: rpriv subfield processing!

# -----------------------------------------------------------------------
#    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!)
#|                     dbfile (or "-")
#|                         dbflags (or "-") ...
#|
#| 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 "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.
#|

#|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
#| userdb          $DBTYPE  root:0:644 -la $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       -lm -d longestmatch
#| routesdb        $DBTYPE  -    -l  $MAILVAR/db/routes         -lm
#| thishost        $DBTYPE  -    -l  $MAILVAR/db/localnames     -lm
#| thishost        unordered -   -   $MAILVAR/db/localnames     -l
#| thishost        bind,mxlocal - -  -                          -l
#| otherservers    unordered -   -   $MAILVAR/db/otherservers   -lm -d pathalias
#| newsgroup       $DBTYPE  -    -l  $MAILVAR/db/active         -lm
#
#

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

sub pick_zenv {

    my ($ZCONFIG) = '/etc/zmailer.conf';

    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;

& pick_zenv();

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

while (<INFN>) {

	next unless(m/^[0-9a-zA-Z]/);
	chomp;
	($rname,$rest) = split(' ',$_);
	$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"

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

    $oo='';
    # --- construct each relation, and binding at lookup, generate the db
    foreach $inp (@inps) {
	($rname,$rtype,$rpriv,$rndbopt, $rdbfile, $rdbflags) = split(' ',$inp);
	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=',';
	if ($rtype =~ m/.*DBTYPE/o) {
		$rdbexttst = '$DBEXTtest';
		$rdbext    = '$DBEXT';
		$rdbtype   = '$DBTYPE';
		system("newdb -s $rndbopt -t $DBTYPE $fn");
		printf ":NEW";
	} elsif ($rtype eq 'ndbm') {
		$rdbexttst = '.pag';
		$rdbtype   = $rtype;
		system("newdb -s $rndbopt -t ndbm $fn");
		printf ":NEW";
	} elsif ($rtype eq 'dbm') {
		$rdbexttst = '.pag';
		$rdbext    = '';
		$rdbtype   = $rtype;
		system("newdb -s $rndbopt -t  dbm $fn");
		printf ":NEW";
	} elsif ($rtype eq 'sdbm') {
		$rdbexttst = '.pag';
		$rdbext    = '';
		$rdbtype   = $rtype;
		system("newdb -s $rndbopt -t sdbm $fn");
		printf ":NEW";
	} elsif ($rtype eq 'gdbm') {
		$rdbexttst = '.gdbm';
		$rdbext    = '.gdbm';
		$rdbtype   = $rtype;
		system("newdb -s $rndbopt -t gdbm $fn");
		printf ":NEW";
	} elsif ($rtype eq 'btree') {
		$rdbexttst = '.db';
		$rdbext    = '.db';
		$rdbtype   = $rtype;
		system("newdb -s $rndbopt -t btree $fn");
		printf ":NEW";
	} elsif ($rtype eq 'bhash') {
		$rdbexttst = '.dbh';
		$rdbext    = '.dbh';
		$rdbtype   = $rtype;
		system("newdb -s $rndbopt -t bhash $fn");
		printf ":NEW";
	} else {
		$rdbexttst = '.dat';
		$rdbext    = '.dat';
	}

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

	} else {
	    # ---- privilege things to collect ----
	    # rpriv is a colon separated duplet/triplet:
	    # ... FIXME! Implement in SH !?  Or change this to PERL ?

	    push(@tfn,
"	if a=\"\$($rn \"\$key\")\"; then
	    priv=\"\$(filepriv -M 644 $rdbfile$rdbexttst \\
			    \$(db owner $rn))\" &&
	    return \"\$a\"
	fi");
	}

	if ($rdbfile eq '-') {
	    push(@ofn, "	relation $rdbflags -t $rtype $rn");
	} else {
	    push(@ofn, "	relation $rdbflags -t $rtype -f $rdbfile$rdbext $rn");
	}
    } # --- foreach $inp (@inps) ....

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

${rel}(key) {
    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;
