|
0
|
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 } |
