#! @PERL@ -w

# a sample Perl interface to the DCC interface daemon, dccifd

# --S-LICENSE--

# $Revision: 1.12 $
# @configure_input@

# check this file by running it separately
use strict 'subs';

use Socket;

# so this file can be used with constructions like do('../dccif.pl')
#   in dccif-test/dccif-test.pl
return 1;


# Returns a string
#   The first character indicates the overall result of the the operation.
#	If the dccifd daemon is not running or there were other problems,
#	the first character is '?', the second is '\n', and the rest of the
#	string is an error message.
#	If things are ok, the first character is one of the
#	DCCIF_RESULT_* values from include/dccif.h and the second is '\n'.
#   If things are ok, the second line is a string of characters, each
#	indicating whether message should be delivered to the corresponding
#	recipient (DCCIF_RCPT_ACCEPT or 'A') or rejected (DCCIF_RCPT_REJECT
#	or 'R').  This string is also ended with a newline ('\n') character.
# The body including headers of the message is read from one file or
#	file handle (e.g. "-").
#	The X-DCC header (if the "header" option is present) or the body
#	with added X-DCC header (if the "body" option is present) is
#	written to a second file or filehandle (e.g. "-").
# The result depends on the -t thresholds given dccifd.
# If the $env_tos or list of targets of the message is empty, this acts
#	as if dccifd is being run with -Q.
sub dccif {
    my($out,			# write X-DCC header or entire body to this
       $opts,			# blank separated string of "spam", ... options
       $clnt_addr,		# SMTP client IP address as a string
       $clnt_name,		# null or SMTP client hostname
       $helo,			# value of SMTP HELO command
       $env_from,		# envelope Mail_From value
       $env_tos,		# array of "address\rname" env_To strings
       $in,			# read body from this
       $homedir) = @_;		# DCC home directory

    my($env_to, $result, $body, $oks, $i);

    $homedir = "@prefix@"
	if (! $homedir);

    if ($clnt_addr) {
	inet_aton($clnt_addr)
	    || return ("", "inet_aton($clnt_addr) failed: $!\n");
    } else {
	$clnt_name = '';
    }

    socket(SOCK, AF_UNIX, SOCK_STREAM, 0)
	|| return("", "socket(AF_UNIX): $!\n");
    connect(SOCK, sockaddr_un("$homedir/dccifd"))
	|| return("", "connect($homedir/dccifd): $!\n");

    # send the options and other parameters to the daemon
    $result = dccif_write($opts . "\012"
			  . $clnt_addr . "\015" . $clnt_name . "\012"
			  . $helo . "\012"
			  . $env_from . "\012",
			  "opts helo clnt");
    return $result if ($result);

    foreach $env_to (@$env_tos) {
	$result = dccif_write($env_to . "\012", "rcpt");
	return $result if ($result);
    }
    $result = dccif_write("\012", "end rcpts");
    return $result if ($result);

    # send the body of the message to the daemon
    if (! open(IFH, $in)) {
	$result = "?\nopen($in): $!\n";
	close(SOCK);
	return $result
    }
    for (;;) {
	$i = sysread(IFH, $body, 8192);
	if (!defined($i)) {
	    $result = "?\nsysread(body): $!\n";
	    close(SOCK);
	    close(IFH);
	    return $result;
	}
	if ($i == 0) {
	    close(IFH);
	    last;
	}
	$result = dccif_write($body, "body");
	if ($result) {
	    close(IFH);
	    return $result;
	}
    }

    # tell the daemon it has all of the message
    if (!shutdown(SOCK, 1)) {
	$result = "shutdown($homedir/dccifd): $!\n";
	close(SOCK);
	return $result;
    }

    # get the result from the daemon
    $result = <SOCK>;
    if (!defined $result) {
	$result = "read($homedir/dccifd): $!\n";
	close(SOCK);
	return $result;
    }
    $oks = <SOCK>;
    if (!defined $oks) {
	$result = "read($homedir/dccifd): $!\n";
	close(SOCK);
	return $result;
    }

    # copy the header or body from the daemon
    if (! open(OFH, ">" . $out)) {
	$result = "?\nopen($in): $!\n";
	close(SOCK);
	return $result
    }
    for (;;) {
	$i = read(SOCK, $body, 8192);
	if (!defined $i) {
	    $result = "?\nread(body): $!\n";
	    close(SOCK);
	    close(OFH);
	    return $result;
	}
	if ($i == 0) {
	    close(SOCK);
	    close(OFH);
	    return $result . $oks;
	}
	if (! syswrite(OFH, $body)) {
	    $result = "?\nsyswrite($out): $!\n";
	    close(SOCK);
	    close(OFH);
	    return $result;
	}
    }
}



sub dccif_write {
    my($buf, $emsg) = @_;
    my $result;

    if (! syswrite(SOCK, $buf)) {
	$result = ("?\nsyswrite($emsg): $!\n");
	close(SOCK);
	return $result
    }
    return "";
}