Mercurial > notdcc

comparison dccifd/dccif.pl.in @ 0:c7f6b056b673

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First import of vendor version
author Peter Gervai <grin@grin.hu>
date Tue, 10 Mar 2009 13:49:58 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:c7f6b056b673
1 #! @PERL@ -w
2
3 # a sample Perl interface to the DCC interface daemon, dccifd
4
5 # Copyright (c) 2008 by Rhyolite Software, LLC
6 #
7 # This agreement is not applicable to any entity which sells anti-spam
8 # solutions to others or provides an anti-spam solution as part of a
9 # security solution sold to other entities, or to a private network
10 # which employs the DCC or uses data provided by operation of the DCC
11 # but does not provide corresponding data to other users.
12 #
13 # Permission to use, copy, modify, and distribute this software without
14 # changes for any purpose with or without fee is hereby granted, provided
15 # that the above copyright notice and this permission notice appear in all
16 # copies and any distributed versions or copies are either unchanged
17 # or not called anything similar to "DCC" or "Distributed Checksum
18 # Clearinghouse".
19 #
20 # Parties not eligible to receive a license under this agreement can
21 # obtain a commercial license to use DCC by contacting Rhyolite Software
22 # at sales@rhyolite.com.
23 #
24 # A commercial license would be for Distributed Checksum and Reputation
25 # Clearinghouse software. That software includes additional features. This
26 # free license for Distributed ChecksumClearinghouse Software does not in any
27 # way grant permision to use Distributed Checksum and Reputation Clearinghouse
28 # software
29 #
30 # THE SOFTWARE IS PROVIDED "AS IS" AND RHYOLITE SOFTWARE, LLC DISCLAIMS ALL
31 # WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES
32 # OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL RHYOLITE SOFTWARE, LLC
33 # BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES
34 # OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
35 # WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
36 # ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
37 # SOFTWARE.
38
39 # Rhyolite Software DCC 1.3.103-1.12 $Revision$
40 # @configure_input@
41
42 # check this file by running it separately
43 use strict 'subs';
44
45 use Socket;
46
47 # so this file can be used with constructions like do('../dccif.pl')
48 # in dccif-test/dccif-test.pl
49 return 1;
50
51
52 # Returns a string
53 # The first character indicates the overall result of the the operation.
54 # If the dccifd daemon is not running or there were other problems,
55 # the first character is '?', the second is '\n', and the rest of the
56 # string is an error message.
57 # If things are ok, the first character is one of the
58 # DCCIF_RESULT_* values from include/dccif.h and the second is '\n'.
59 # If things are ok, the second line is a string of characters, each
60 # indicating whether message should be delivered to the corresponding
61 # recipient (DCCIF_RCPT_ACCEPT or 'A') or rejected (DCCIF_RCPT_REJECT
62 # or 'R'). This string is also ended with a newline ('\n') character.
63 # The body including headers of the message is read from one file or
64 # file handle (e.g. "-").
65 # The X-DCC header (if the "header" option is present) or the body
66 # with added X-DCC header (if the "body" option is present) is
67 # written to a second file or filehandle (e.g. "-").
68 # The result depends on the -t thresholds given dccifd.
69 # If the $env_tos or list of targets of the message is empty, this acts
70 # as if dccifd is being run with -Q.
71 sub dccif {
72 my($out, # write X-DCC header or entire body to this
73 $opts, # blank separated string of "spam", ... options
74 $clnt_addr, # SMTP client IP address as a string
75 $clnt_name, # null or SMTP client hostname
76 $helo, # value of SMTP HELO command
77 $env_from, # envelope Mail_From value
78 $env_tos, # array of "address\rname" env_To strings
79 $in, # read body from this
80 $homedir) = @_; # DCC home directory
81
82 my($env_to, $result, $body, $oks, $i);
83
84 $homedir = "@prefix@"
85 if (! $homedir);
86
87 if ($clnt_addr) {
88 inet_aton($clnt_addr)
89 || return ("", "inet_aton($clnt_addr) failed: $!\n");
90 } else {
91 $clnt_name = '';
92 }
93
94 socket(SOCK, AF_UNIX, SOCK_STREAM, 0)
95 || return("", "socket(AF_UNIX): $!\n");
96 connect(SOCK, sockaddr_un("$homedir/dccifd"))
97 || return("", "connect($homedir/dccifd): $!\n");
98
99 # send the options and other parameters to the daemon
100 $result = dccif_write($opts . "\012"
101 . $clnt_addr . "\015" . $clnt_name . "\012"
102 . $helo . "\012"
103 . $env_from . "\012",
104 "opts helo clnt");
105 return $result if ($result);
106
107 foreach $env_to (@$env_tos) {
108 $result = dccif_write($env_to . "\012", "rcpt");
109 return $result if ($result);
110 }
111 $result = dccif_write("\012", "end rcpts");
112 return $result if ($result);
113
114 # send the body of the message to the daemon
115 if (! open(IFH, $in)) {
116 $result = "?\nopen($in): $!\n";
117 close(SOCK);
118 return $result
119 }
120 for (;;) {
121 $i = sysread(IFH, $body, 8192);
122 if (!defined($i)) {
123 $result = "?\nsysread(body): $!\n";
124 close(SOCK);
125 close(IFH);
126 return $result;
127 }
128 if ($i == 0) {
129 close(IFH);
130 last;
131 }
132 $result = dccif_write($body, "body");
133 if ($result) {
134 close(IFH);
135 return $result;
136 }
137 }
138
139 # tell the daemon it has all of the message
140 if (!shutdown(SOCK, 1)) {
141 $result = "shutdown($homedir/dccifd): $!\n";
142 close(SOCK);
143 return $result;
144 }
145
146 # get the result from the daemon
147 $result = <SOCK>;
148 if (!defined $result) {
149 $result = "read($homedir/dccifd): $!\n";
150 close(SOCK);
151 return $result;
152 }
153 $oks = <SOCK>;
154 if (!defined $oks) {
155 $result = "read($homedir/dccifd): $!\n";
156 close(SOCK);
157 return $result;
158 }
159
160 # copy the header or body from the daemon
161 if (! open(OFH, ">" . $out)) {
162 $result = "?\nopen($in): $!\n";
163 close(SOCK);
164 return $result
165 }
166 for (;;) {
167 $i = read(SOCK, $body, 8192);
168 if (!defined $i) {
169 $result = "?\nread(body): $!\n";
170 close(SOCK);
171 close(OFH);
172 return $result;
173 }
174 if ($i == 0) {
175 close(SOCK);
176 close(OFH);
177 return $result . $oks;
178 }
179 if (! syswrite(OFH, $body)) {
180 $result = "?\nsyswrite($out): $!\n";
181 close(SOCK);
182 close(OFH);
183 return $result;
184 }
185 }
186 }
187
188
189
190 sub dccif_write {
191 my($buf, $emsg) = @_;
192 my $result;
193
194 if (! syswrite(SOCK, $buf)) {
195 $result = ("?\nsyswrite($emsg): $!\n");
196 close(SOCK);
197 return $result
198 }
199 return "";
200 }