Skip to content
Newer
Older
100644 476 lines (381 sloc) 12.9 KB
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
1 package Qpsmtpd;
2 use strict;
9cbf206 * lib/Qpsmtpd/TcpServer.pm
John Peacock authored Sep 22, 2005
3 use vars qw($VERSION $Logger $TraceLevel $Spool_dir $Size_threshold);
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
4
806fcf2 @abh Reorganize most of Qpsmtpd.pm into Qpsmtpd/SMTP.pm.
abh authored Sep 24, 2002
5 use Sys::Hostname;
6 use Qpsmtpd::Constants;
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
7
351f0b7 @abh r4521@g5: ask | 2006-02-27 13:41:09 -0800
abh authored Feb 27, 2006
8 $VERSION = "0.33-dev";
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored Mar 5, 2004
9
10 sub version { $VERSION };
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
11
6620034 * qpsmtpd-forkserver
John Peacock authored May 25, 2005
12 sub TRACE_LEVEL { $TraceLevel }; # leave for plugin compatibility
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
13
14 sub load_logging {
15 # need to do this differently that other plugins so as to
16 # not trigger logging activity
17 my $self = shift;
18 return if $self->{hooks}->{"logging"};
19 my $configdir = $self->config_dir("logging");
20 my $configfile = "$configdir/logging";
21 my @loggers = $self->_config_from_file($configfile,'logging');
22 my $dir = $self->plugin_dir;
23
24 $self->_load_plugins($dir, @loggers);
25
26 foreach my $logger (@loggers) {
27 $self->log(LOGINFO, "Loaded $logger");
28 }
29
30 return @loggers;
31 }
32
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored Mar 29, 2005
33 sub trace_level {
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
34 my $self = shift;
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored Mar 29, 2005
35 return $TraceLevel if $TraceLevel;
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
36
37 my $configdir = $self->config_dir("loglevel");
38 my $configfile = "$configdir/loglevel";
6620034 * qpsmtpd-forkserver
John Peacock authored May 25, 2005
39 $TraceLevel = $self->_config_from_file($configfile,'loglevel');
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
40
6620034 * qpsmtpd-forkserver
John Peacock authored May 25, 2005
41 unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored Mar 29, 2005
42 $TraceLevel = LOGWARN; # Default if no loglevel file found.
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
43 }
44
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored Mar 29, 2005
45 return $TraceLevel;
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored Mar 5, 2004
46 }
47
6620034 * qpsmtpd-forkserver
John Peacock authored May 25, 2005
48 sub init_logger { # needed for compatibility purposes
49 shift->trace_level();
50 }
51
806fcf2 @abh Reorganize most of Qpsmtpd.pm into Qpsmtpd/SMTP.pm.
abh authored Sep 24, 2002
52 sub log {
53 my ($self, $trace, @log) = @_;
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
54 $self->varlog($trace,join(" ",@log));
55 }
56
57 sub varlog {
58 my ($self, $trace) = (shift,shift);
59 my ($hook, $plugin, @log);
60 if ( $#_ == 0 ) { # log itself
61 (@log) = @_;
62 }
63 elsif ( $#_ == 1 ) { # plus the hook
64 ($hook, @log) = @_;
65 }
66 else { # called from plugin
67 ($hook, $plugin, @log) = @_;
68 }
69
70 $self->load_logging; # in case we already don't have this loaded yet
71
72 my ($rc) = $self->run_hooks("logging", $trace, $hook, $plugin, @log);
73
74 unless ( $rc and $rc == DECLINED or $rc == OK ) {
75 # no logging plugins registered so fall back to STDERR
76 warn join(" ", $$ .
77 (defined $plugin ? " $plugin plugin:" :
78 defined $hook ? " running plugin ($hook):" : ""),
79 @log), "\n"
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored Mar 29, 2005
80 if $trace <= $self->trace_level();
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
81 }
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
82 }
83
84 #
85 # method to get the configuration. It just calls get_qmail_config by
86 # default, but it could be overwritten to look configuration up in a
87 # database or whatever.
88 #
89 sub config {
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
90 my ($self, $c, $type) = @_;
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
91
173a2d2 @abh better error messages when a plugin fails
abh authored Oct 17, 2002
92 #warn "SELF->config($c) ", ref $self;
806fcf2 @abh Reorganize most of Qpsmtpd.pm into Qpsmtpd/SMTP.pm.
abh authored Sep 24, 2002
93
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
94 my %defaults = (
95 me => hostname,
96 timeout => 1200,
97 );
98
9d5610a @abh 0.20-dev
abh authored Nov 6, 2002
99 my ($rc, @config) = $self->run_hooks("config", $c);
100 @config = () unless $rc == OK;
101
3e5de3a @abh separate queue method called from data.
abh authored Jul 6, 2002
102 if (wantarray) {
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
103 @config = $self->get_qmail_config($c, $type) unless @config;
bae4a84 Fixed defaults bug (freeside)
Matt Sergeant authored Jul 24, 2003
104 @config = $defaults{$c} if (!@config and $defaults{$c});
3e5de3a @abh separate queue method called from data.
abh authored Jul 6, 2002
105 return @config;
106 }
107 else {
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
108 return ($config[0] || $self->get_qmail_config($c, $type) || $defaults{$c});
3e5de3a @abh separate queue method called from data.
abh authored Jul 6, 2002
109 }
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
110 }
111
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
112 sub config_dir {
113 my ($self, $config) = @_;
114 my $configdir = ($ENV{QMAIL} || '/var/qmail') . '/control';
115 my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
116 $configdir = "$name/config" if (-e "$name/config/$config");
deb3380 @aqua Apply slight variation on patch from Peter Holzer to allow specificat…
aqua authored Jul 29, 2005
117 if (exists $ENV{QPSMTPD_CONFIG}) {
118 $ENV{QPSMTPD_CONFIG} =~ /^(.*)$/; # detaint
119 $configdir = $1 if -e "$1/$config";
120 }
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
121 return $configdir;
122 }
123
124 sub plugin_dir {
c78dad0 Revert to proper versions
Matt Sergeant authored Jul 7, 2005
125 my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
126 my $dir = "$name/plugins";
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
127 }
2fe35f1 @abh yay, plugin support works! :-D
abh authored Jul 8, 2002
128
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
129 sub get_qmail_config {
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
130 my ($self, $config, $type) = @_;
c78dad0 Revert to proper versions
Matt Sergeant authored Jul 7, 2005
131 $self->log(LOGDEBUG, "trying to get config for $config");
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
132 if ($self->{_config_cache}->{$config}) {
133 return wantarray ? @{$self->{_config_cache}->{$config}} : $self->{_config_cache}->{$config}->[0];
134 }
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
135 my $configdir = $self->config_dir($config);
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
136
137 my $configfile = "$configdir/$config";
138
139 if ($type and $type eq "map") {
e006f74 @abh Use $ENV{QMAIL} to override /var/qmail for where to find the
abh authored Aug 30, 2003
140 return +{} unless -e $configfile . ".cdb";
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
141 eval { require CDB_File };
142
143 if ($@) {
a979f83 @abh fix the CDB support so we can work without it (but with a big warning)
abh authored Jul 18, 2004
144 $self->log(LOGERROR, "No CDB Support! Did NOT read $configfile.cdb, could not load CDB_File module: $@");
145 return +{};
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
146 }
a979f83 @abh fix the CDB support so we can work without it (but with a big warning)
abh authored Jul 18, 2004
147
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
148 my %h;
149 unless (tie(%h, 'CDB_File', "$configfile.cdb")) {
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored Mar 5, 2004
150 $self->log(LOGERROR, "tie of $configfile.cdb failed: $!");
151 return +{};
c10b6fb @abh Support morercpthosts.cdb
abh authored Mar 25, 2003
152 }
153 #warn Data::Dumper->Dump([\%h], [qw(h)]);
154 # should we cache this?
155 return \%h;
156 }
157
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored Mar 5, 2004
158 return $self->_config_from_file($configfile, $config);
159 }
160
161 sub _config_from_file {
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored Jul 31, 2005
162 my ($self, $configfile, $config, $visited) = @_;
1eafaba @abh don't try to open configuration files that does not exist.
abh authored Jun 10, 2003
163 return unless -e $configfile;
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored Jul 31, 2005
164
165 $visited ||= [];
166 push @{$visited}, $configfile;
167
9b150df @abh Fix bug hiding the error message when an existing configuration file
abh authored Apr 23, 2003
168 open CF, "<$configfile" or warn "$$ could not open configfile $configfile: $!" and return;
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
169 my @config = <CF>;
170 chomp @config;
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored Mar 5, 2004
171 @config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/} @config;
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
172 close CF;
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored Jul 31, 2005
173
174 my $pos = 0;
175 while ($pos < @config) {
176 # recursively pursue an $include reference, if found. An inclusion which
177 # begins with a leading slash is interpreted as a path to a file and will
178 # supercede the usual config path resolution. Otherwise, the normal
179 # config_dir() lookup is employed (the location in which the inclusion
180 # appeared receives no special precedence; possibly it should, but it'd
181 # be complicated beyond justifiability for so simple a config system.
182 if ($config[$pos] =~ /^\s*\$include\s+(\S+)\s*$/) {
183 my ($includedir, $inclusion) = ('', $1);
184
185 splice @config, $pos, 1; # remove the $include line
186 if ($inclusion !~ /^\//) {
187 $includedir = $self->config_dir($inclusion);
188 $inclusion = "$includedir/$inclusion";
189 }
190
191 if (grep($_ eq $inclusion, @{$visited})) {
192 $self->log(LOGERROR, "Circular \$include reference in config $config:");
193 $self->log(LOGERROR, "From $visited->[0]:");
194 $self->log(LOGERROR, " includes $_")
195 for (@{$visited}[1..$#{$visited}], $inclusion);
196 return wantarray ? () : undef;
197 }
198 push @{$visited}, $inclusion;
199
200 for my $inc ($self->expand_inclusion_($inclusion, $configfile)) {
201 my @insertion = $self->_config_from_file($inc, $config, $visited);
202 splice @config, $pos, 0, @insertion; # insert the inclusion
203 $pos += @insertion;
204 }
205 } else {
206 $pos++;
207 }
208 }
209
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
210 $self->{_config_cache}->{$config} = \@config;
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored Jul 31, 2005
211
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
212 return wantarray ? @config : $config[0];
213 }
214
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored Jul 31, 2005
215 sub expand_inclusion_ {
216 my $self = shift;
217 my $inclusion = shift;
218 my $context = shift;
219 my @includes;
220
221 if (-d $inclusion) {
222 $self->log(LOGDEBUG, "inclusion of directory $inclusion from $context");
223
224 if (opendir(INCD, $inclusion)) {
225 @includes = map { "$inclusion/$_" }
226 (grep { -f "$inclusion/$_" and !/^\./ } readdir INCD);
227 closedir INCD;
228 } else {
229 $self->log(LOGERROR, "Couldn't open directory $inclusion,".
230 " referenced from $context ($!)");
231 }
232 } else {
233 $self->log(LOGDEBUG, "inclusion of file $inclusion from $context");
234 @includes = ( $inclusion );
235 }
236 return @includes;
237 }
238
239
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
240 sub load_plugins {
241 my $self = shift;
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored Aug 31, 2004
242
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored Mar 29, 2005
243 $self->log(LOGWARN, "Plugins already loaded") if $self->{hooks};
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
244 $self->{hooks} = {};
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored Aug 31, 2004
245
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
246 my @plugins = $self->config('plugins');
247
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
248 my $dir = $self->plugin_dir;
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored Mar 5, 2004
249 $self->log(LOGNOTICE, "loading plugins from $dir");
250
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
251 @plugins = $self->_load_plugins($dir, @plugins);
252
253 return @plugins;
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored Mar 5, 2004
254 }
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
255
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored Mar 5, 2004
256 sub _load_plugins {
257 my $self = shift;
258 my ($dir, @plugins) = @_;
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
259
260 my @ret;
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
261 for my $plugin_line (@plugins) {
f72647a * lib/Qpsmtpd.pm
John Peacock authored Mar 25, 2005
262 my ($plugin, @args) = split ' ', $plugin_line;
9d5610a @abh 0.20-dev
abh authored Nov 6, 2002
263
bf2419d @abh r3744@embla: ask | 2006-06-28 13:04:50 -0700
abh authored Jun 28, 2006
264 my $package;
265
266 if ($plugin =~ m/::/) {
267 # "full" package plugin (My::Plugin)
268 $package = $plugin;
269 $package =~ s/[^_a-z0-9:]+//gi;
270 my $eval = qq[require $package;\n]
271 .qq[sub ${plugin}::plugin_name { '$plugin' }];
272 $eval =~ m/(.*)/s;
273 $eval = $1;
274 eval $eval;
275 die "Failed loading $package - eval $@" if $@;
276 $self->log(LOGDEBUG, "Loading $package ($plugin_line)")
277 unless $plugin_line =~ /logging/;
278 }
279 else {
280 # regular plugins/$plugin plugin
281 my $plugin_name = $plugin;
282 $plugin =~ s/:\d+$//; # after this point, only used for filename
283
284 # Escape everything into valid perl identifiers
285 $plugin_name =~ s/([^A-Za-z0-9_\/])/sprintf("_%2x",unpack("C",$1))/eg;
286
287 # second pass cares for slashes and words starting with a digit
288 $plugin_name =~ s{
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
289 (/+) # directory
290 (\d?) # package's first character
291 }[
292 "::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "")
293 ]egx;
bf2419d @abh r3744@embla: ask | 2006-06-28 13:04:50 -0700
abh authored Jun 28, 2006
294
295 $package = "Qpsmtpd::Plugin::$plugin_name";
296
297 # don't reload plugins if they are already loaded
298 unless ( defined &{"${package}::plugin_name"} ) {
299 Qpsmtpd::Plugin->compile($plugin_name,
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
300 $package, "$dir/$plugin", $self->{_test_mode});
bf2419d @abh r3744@embla: ask | 2006-06-28 13:04:50 -0700
abh authored Jun 28, 2006
301 $self->log(LOGDEBUG, "Loading $plugin_line")
302 unless $plugin_line =~ /logging/;
303 }
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
304 }
bf2419d @abh r3744@embla: ask | 2006-06-28 13:04:50 -0700
abh authored Jun 28, 2006
305
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored Aug 31, 2004
306 my $plug = $package->new();
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
307 push @ret, $plug;
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored Aug 31, 2004
308 $plug->_register($self, @args);
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
309
2fe35f1 @abh yay, plugin support works! :-D
abh authored Jul 8, 2002
310 }
9224e43 Plugin testing framework.
Matt Sergeant authored Sep 8, 2004
311
312 return @ret;
2fe35f1 @abh yay, plugin support works! :-D
abh authored Jul 8, 2002
313 }
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
314
c78dad0 Revert to proper versions
Matt Sergeant authored Jul 7, 2005
315 sub transaction {
316 return {}; # base class implements empty transaction
317 }
318
2fe35f1 @abh yay, plugin support works! :-D
abh authored Jul 8, 2002
319 sub run_hooks {
320 my ($self, $hook) = (shift, shift);
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored Aug 31, 2004
321 my $hooks = $self->{hooks};
322 if ($hooks->{$hook}) {
2fe35f1 @abh yay, plugin support works! :-D
abh authored Jul 8, 2002
323 my @r;
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored Aug 31, 2004
324 for my $code (@{$hooks->{$hook}}) {
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
325 if ( $hook eq 'logging' ) { # without calling $self->log()
326 eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
327 $@ and warn("FATAL LOGGING PLUGIN ERROR: ", $@) and next;
328 }
329 else {
330 $self->varlog(LOGINFO, $hook, $code->{name});
331 eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
332 $@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;
e8bf828 @rspier reindent undef check
rspier authored Sep 4, 2004
333
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
334 !defined $r[0]
335 and $self->log(LOGERROR, "plugin ".$code->{name}
336 ." running the $hook hook returned undef!")
e8bf828 @rspier reindent undef check
rspier authored Sep 4, 2004
337 and next;
5eec66f @abh add deny hook (Rasjid Wilcox)
abh authored Jan 20, 2003
338
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
339 if ($self->transaction) {
340 my $tnotes = $self->transaction->notes( $code->{name} );
341 $tnotes->{"hook_$hook"}->{'return'} = $r[0]
342 if (!defined $tnotes || ref $tnotes eq "HASH");
343 } else {
344 my $cnotes = $self->connection->notes( $code->{name} );
345 $cnotes->{"hook_$hook"}->{'return'} = $r[0]
346 if (!defined $cnotes || ref $cnotes eq "HASH");
347 }
348
349 # should we have a hook for "OK" too?
350 if ($r[0] == DENY or $r[0] == DENYSOFT or
351 $r[0] == DENY_DISCONNECT or $r[0] == DENYSOFT_DISCONNECT)
352 {
353 $r[1] = "" if not defined $r[1];
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored Mar 29, 2005
354 $self->log(LOGDEBUG, "Plugin ".$code->{name}.
355 ", hook $hook returned ".return_code($r[0]).", $r[1]");
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
356 $self->run_hooks("deny", $code->{name}, $r[0], $r[1]) unless ($hook eq "deny");
357 } else {
358 $r[1] = "" if not defined $r[1];
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored Mar 29, 2005
359 $self->log(LOGDEBUG, "Plugin ".$code->{name}.
360 ", hook $hook returned ".return_code($r[0]).", $r[1]");
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
361 $self->run_hooks("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok");
362 }
5128bd0 @rspier new plugin output tracking
rspier authored Sep 4, 2004
363
5eec66f @abh add deny hook (Rasjid Wilcox)
abh authored Jan 20, 2003
364 }
365
bdd20fe @rspier indentation and whitespace cleanup
rspier authored Sep 4, 2004
366 last unless $r[0] == DECLINED;
2fe35f1 @abh yay, plugin support works! :-D
abh authored Jul 8, 2002
367 }
9d5610a @abh 0.20-dev
abh authored Nov 6, 2002
368 $r[0] = DECLINED if not defined $r[0];
b89a6d9 * plugins/queue/smtp-forward
John Peacock authored Mar 20, 2006
369 @r = map { split /\n/ } @r;
2fe35f1 @abh yay, plugin support works! :-D
abh authored Jul 8, 2002
370 return @r;
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
371 }
2fe35f1 @abh yay, plugin support works! :-D
abh authored Jul 8, 2002
372 return (0, '');
373 }
374
375 sub _register_hook {
376 my $self = shift;
0e5b4e6 Add unshift parameter to register_hook, allowing you to put the hook …
Matt Sergeant authored Jun 11, 2004
377 my ($hook, $code, $unshift) = @_;
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
378
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored Aug 31, 2004
379 my $hooks = $self->{hooks};
0e5b4e6 Add unshift parameter to register_hook, allowing you to put the hook …
Matt Sergeant authored Jun 11, 2004
380 if ($unshift) {
381 unshift @{$hooks->{$hook}}, $code;
382 }
383 else {
384 push @{$hooks->{$hook}}, $code;
385 }
e0d93d1 @abh semi working plugin stuff
abh authored Jul 6, 2002
386 }
387
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored Feb 22, 2005
388 sub spool_dir {
389 my $self = shift;
390
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
391 unless ( $Spool_dir ) { # first time through
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored Mar 1, 2005
392 $self->log(LOGINFO, "Initializing spool_dir");
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
393 $Spool_dir = $self->config('spool_dir')
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored Mar 1, 2005
394 || Qpsmtpd::Utils::tildeexp('~/tmp/');
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored Feb 22, 2005
395
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
396 $Spool_dir .= "/" unless ($Spool_dir =~ m!/$!);
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored Mar 1, 2005
397
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
398 $Spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly";
399 $Spool_dir = $1; # cleanse the taint
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored Feb 22, 2005
400
401 # Make sure the spool dir has appropriate rights
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
402 if (-e $Spool_dir) {
403 my $mode = (stat($Spool_dir))[2];
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored Mar 1, 2005
404 $self->log(LOGWARN,
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
405 "Permissions on spool_dir $Spool_dir are not 0700")
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored Mar 1, 2005
406 if $mode & 07077;
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored Feb 22, 2005
407 }
408
409 # And finally, create it if it doesn't already exist
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
410 -d $Spool_dir or mkdir($Spool_dir, 0700)
411 or die "Could not create spool_dir $Spool_dir: $!";
412 }
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored Mar 1, 2005
413
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored Mar 24, 2005
414 return $Spool_dir;
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored Feb 22, 2005
415 }
416
417 # For unique filenames. We write to a local tmp dir so we don't need
418 # to make them unpredictable.
419 my $transaction_counter = 0;
420
421 sub temp_file {
422 my $self = shift;
423 my $filename = $self->spool_dir()
424 . join(":", time, $$, $transaction_counter++);
425 return $filename;
426 }
427
428 sub temp_dir {
429 my $self = shift;
430 my $mask = shift || 0700;
431 my $dirname = $self->temp_file();
432 -d $dirname or mkdir($dirname, $mask)
433 or die "Could not create temporary directory $dirname: $!";
434 return $dirname;
435 }
436
9cbf206 * lib/Qpsmtpd/TcpServer.pm
John Peacock authored Sep 22, 2005
437 sub size_threshold {
438 my $self = shift;
439 unless ( defined $Size_threshold ) {
4b3fdf5 * lib/Qpsmtpd.pm
John Peacock authored Sep 22, 2005
440 $Size_threshold = $self->config('size_threshold') || 0;
9cbf206 * lib/Qpsmtpd/TcpServer.pm
John Peacock authored Sep 22, 2005
441 $self->log(LOGNOTICE, "size_threshold set to $Size_threshold");
442 }
443 return $Size_threshold;
444 }
5959cc1 * lib/Qpsmtpd/Auth.pm
John Peacock authored Oct 31, 2005
445
446 sub auth_user {
447 my $self = shift;
448 return (defined $self->{_auth_user} ? $self->{_auth_user} : "" );
449 }
450
451 sub auth_mechanism {
452 my $self = shift;
453 return (defined $self->{_auth_mechanism} ? $self->{_auth_mechanism} : "" );
454 }
9cbf206 * lib/Qpsmtpd/TcpServer.pm
John Peacock authored Sep 22, 2005
455
6df92cd @abh half baked version of the new object mail engine
abh authored Jul 3, 2002
456 1;
3b7bfe9 @abh update the MANIFEST
abh authored Jul 2, 2005
457
458 __END__
459
460 =head1 NAME
461
462 Qpsmtpd
463
464 =head1 DESCRIPTION
465
466 This is the base class for the qpsmtpd mail server. See
467 L<http://smtpd.develooper.com/> and the I<README> file for more information.
468
469 =head1 COPYRIGHT
470
471 Copyright 2001-2005 Ask Bjoern Hansen, Develooper LLC. See the
472 LICENSE file for more information.
473
474
475
Something went wrong with that request. Please try again.