Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 438 lines (347 sloc) 12.156 kB
6df92cd @abh half baked version of the new object mail engine
abh authored
1 package Qpsmtpd;
2 use strict;
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored
3 use vars qw($VERSION $Logger $TraceLevel $Spool_dir);
6df92cd @abh half baked version of the new object mail engine
abh authored
4
806fcf2 @abh Reorganize most of Qpsmtpd.pm into Qpsmtpd/SMTP.pm.
abh authored
5 use Sys::Hostname;
6 use Qpsmtpd::Constants;
6df92cd @abh half baked version of the new object mail engine
abh authored
7
df5a2e9 @abh bump version to 0.31-dev
abh authored
8 $VERSION = "0.31-dev";
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored
9
10 sub version { $VERSION };
6df92cd @abh half baked version of the new object mail engine
abh authored
11
6620034 * qpsmtpd-forkserver
John Peacock authored
12 sub TRACE_LEVEL { $TraceLevel }; # leave for plugin compatibility
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
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
33 sub trace_level {
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
34 my $self = shift;
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored
35 return $TraceLevel if $TraceLevel;
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
36
37 my $configdir = $self->config_dir("loglevel");
38 my $configfile = "$configdir/loglevel";
6620034 * qpsmtpd-forkserver
John Peacock authored
39 $TraceLevel = $self->_config_from_file($configfile,'loglevel');
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
40
6620034 * qpsmtpd-forkserver
John Peacock authored
41 unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) {
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored
42 $TraceLevel = LOGWARN; # Default if no loglevel file found.
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
43 }
44
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored
45 return $TraceLevel;
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored
46 }
47
6620034 * qpsmtpd-forkserver
John Peacock authored
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
52 sub log {
53 my ($self, $trace, @log) = @_;
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
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
80 if $trace <= $self->trace_level();
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
81 }
6df92cd @abh half baked version of the new object mail engine
abh authored
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
90 my ($self, $c, $type) = @_;
6df92cd @abh half baked version of the new object mail engine
abh authored
91
173a2d2 @abh better error messages when a plugin fails
abh authored
92 #warn "SELF->config($c) ", ref $self;
806fcf2 @abh Reorganize most of Qpsmtpd.pm into Qpsmtpd/SMTP.pm.
abh authored
93
6df92cd @abh half baked version of the new object mail engine
abh authored
94 my %defaults = (
95 me => hostname,
96 timeout => 1200,
97 );
98
9d5610a @abh 0.20-dev
abh authored
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
102 if (wantarray) {
c10b6fb @abh Support morercpthosts.cdb
abh authored
103 @config = $self->get_qmail_config($c, $type) unless @config;
bae4a84 Fixed defaults bug (freeside)
Matt Sergeant authored
104 @config = $defaults{$c} if (!@config and $defaults{$c});
3e5de3a @abh separate queue method called from data.
abh authored
105 return @config;
106 }
107 else {
c10b6fb @abh Support morercpthosts.cdb
abh authored
108 return ($config[0] || $self->get_qmail_config($c, $type) || $defaults{$c});
3e5de3a @abh separate queue method called from data.
abh authored
109 }
6df92cd @abh half baked version of the new object mail engine
abh authored
110 }
111
9224e43 Plugin testing framework.
Matt Sergeant authored
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
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
121 return $configdir;
122 }
123
124 sub plugin_dir {
c78dad0 Revert to proper versions
Matt Sergeant authored
125 my ($name) = ($0 =~ m!(.*?)/([^/]+)$!);
126 my $dir = "$name/plugins";
9224e43 Plugin testing framework.
Matt Sergeant authored
127 }
2fe35f1 @abh yay, plugin support works! :-D
abh authored
128
6df92cd @abh half baked version of the new object mail engine
abh authored
129 sub get_qmail_config {
c10b6fb @abh Support morercpthosts.cdb
abh authored
130 my ($self, $config, $type) = @_;
c78dad0 Revert to proper versions
Matt Sergeant authored
131 $self->log(LOGDEBUG, "trying to get config for $config");
6df92cd @abh half baked version of the new object mail engine
abh authored
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
135 my $configdir = $self->config_dir($config);
c10b6fb @abh Support morercpthosts.cdb
abh authored
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
140 return +{} unless -e $configfile . ".cdb";
c10b6fb @abh Support morercpthosts.cdb
abh authored
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
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
146 }
a979f83 @abh fix the CDB support so we can work without it (but with a big warning)
abh authored
147
c10b6fb @abh Support morercpthosts.cdb
abh authored
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
150 $self->log(LOGERROR, "tie of $configfile.cdb failed: $!");
151 return +{};
c10b6fb @abh Support morercpthosts.cdb
abh authored
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
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
162 my ($self, $configfile, $config, $visited) = @_;
1eafaba @abh don't try to open configuration files that does not exist.
abh authored
163 return unless -e $configfile;
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored
164
165 $visited ||= [];
166 push @{$visited}, $configfile;
167
9b150df @abh Fix bug hiding the error message when an existing configuration file
abh authored
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
169 my @config = <CF>;
170 chomp @config;
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored
171 @config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/} @config;
6df92cd @abh half baked version of the new object mail engine
abh authored
172 close CF;
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored
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
210 $self->{_config_cache}->{$config} = \@config;
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored
211
6df92cd @abh half baked version of the new object mail engine
abh authored
212 return wantarray ? @config : $config[0];
213 }
214
6f23c46 @aqua Generalize '$include' support from plugin configuration to cover all …
aqua authored
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
240 sub load_plugins {
241 my $self = shift;
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored
242
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored
243 $self->log(LOGWARN, "Plugins already loaded") if $self->{hooks};
9224e43 Plugin testing framework.
Matt Sergeant authored
244 $self->{hooks} = {};
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored
245
e0d93d1 @abh semi working plugin stuff
abh authored
246 my @plugins = $self->config('plugins');
247
9224e43 Plugin testing framework.
Matt Sergeant authored
248 my $dir = $self->plugin_dir;
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored
249 $self->log(LOGNOTICE, "loading plugins from $dir");
250
9224e43 Plugin testing framework.
Matt Sergeant authored
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
254 }
e0d93d1 @abh semi working plugin stuff
abh authored
255
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored
256 sub _load_plugins {
257 my $self = shift;
258 my ($dir, @plugins) = @_;
9224e43 Plugin testing framework.
Matt Sergeant authored
259
260 my @ret;
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
261 for my $plugin_line (@plugins) {
f72647a * lib/Qpsmtpd.pm
John Peacock authored
262 my ($plugin, @args) = split ' ', $plugin_line;
03b8cda Don't keep the _qp around - just pass it in to each hook.
Matt Sergeant authored
263
e0d93d1 @abh semi working plugin stuff
abh authored
264 my $plugin_name = $plugin;
ec5e23a @rspier Allow for multiple instances of a single plugin by using plugin:0
rspier authored
265 $plugin =~ s/:\d+$//; # after this point, only used for filename
9d5610a @abh 0.20-dev
abh authored
266
e0d93d1 @abh semi working plugin stuff
abh authored
267 # Escape everything into valid perl identifiers
268 $plugin_name =~ s/([^A-Za-z0-9_\/])/sprintf("_%2x",unpack("C",$1))/eg;
269
270 # second pass cares for slashes and words starting with a digit
271 $plugin_name =~ s{
272 (/+) # directory
273 (\d?) # package's first character
274 }[
275 "::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "")
276 ]egx;
277
9c700b1 New for 0.28: Log levels and $Include for config/plugins
Matt Sergeant authored
278 my $package = "Qpsmtpd::Plugin::$plugin_name";
279
29bbbec Check for register() function after fixing plugin name (major speedup…
Matt Sergeant authored
280 # don't reload plugins if they are already loaded
3707751 This fixes the redefined warnings.
John Peacock authored
281 unless ( defined &{"${package}::plugin_name"} ) {
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
282 Qpsmtpd::Plugin->compile($plugin_name,
283 $package, "$dir/$plugin", $self->{_test_mode});
284 $self->log(LOGDEBUG, "Loading $plugin_line")
285 unless $plugin_line =~ /logging/;
286 }
03b8cda Don't keep the _qp around - just pass it in to each hook.
Matt Sergeant authored
287
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored
288 my $plug = $package->new();
9224e43 Plugin testing framework.
Matt Sergeant authored
289 push @ret, $plug;
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored
290 $plug->_register($self, @args);
e0d93d1 @abh semi working plugin stuff
abh authored
291
2fe35f1 @abh yay, plugin support works! :-D
abh authored
292 }
9224e43 Plugin testing framework.
Matt Sergeant authored
293
294 return @ret;
2fe35f1 @abh yay, plugin support works! :-D
abh authored
295 }
e0d93d1 @abh semi working plugin stuff
abh authored
296
c78dad0 Revert to proper versions
Matt Sergeant authored
297 sub transaction {
298 return {}; # base class implements empty transaction
299 }
300
2fe35f1 @abh yay, plugin support works! :-D
abh authored
301 sub run_hooks {
302 my ($self, $hook) = (shift, shift);
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored
303 my $hooks = $self->{hooks};
304 if ($hooks->{$hook}) {
2fe35f1 @abh yay, plugin support works! :-D
abh authored
305 my @r;
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored
306 for my $code (@{$hooks->{$hook}}) {
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
307 if ( $hook eq 'logging' ) { # without calling $self->log()
308 eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
309 $@ and warn("FATAL LOGGING PLUGIN ERROR: ", $@) and next;
310 }
311 else {
312 $self->varlog(LOGINFO, $hook, $code->{name});
313 eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
314 $@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;
e8bf828 @rspier reindent undef check
rspier authored
315
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
316 !defined $r[0]
317 and $self->log(LOGERROR, "plugin ".$code->{name}
318 ." running the $hook hook returned undef!")
e8bf828 @rspier reindent undef check
rspier authored
319 and next;
5eec66f @abh add deny hook (Rasjid Wilcox)
abh authored
320
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
321 if ($self->transaction) {
322 my $tnotes = $self->transaction->notes( $code->{name} );
323 $tnotes->{"hook_$hook"}->{'return'} = $r[0]
324 if (!defined $tnotes || ref $tnotes eq "HASH");
325 } else {
326 my $cnotes = $self->connection->notes( $code->{name} );
327 $cnotes->{"hook_$hook"}->{'return'} = $r[0]
328 if (!defined $cnotes || ref $cnotes eq "HASH");
329 }
330
331 # should we have a hook for "OK" too?
332 if ($r[0] == DENY or $r[0] == DENYSOFT or
333 $r[0] == DENY_DISCONNECT or $r[0] == DENYSOFT_DISCONNECT)
334 {
335 $r[1] = "" if not defined $r[1];
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored
336 $self->log(LOGDEBUG, "Plugin ".$code->{name}.
337 ", hook $hook returned ".return_code($r[0]).", $r[1]");
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
338 $self->run_hooks("deny", $code->{name}, $r[0], $r[1]) unless ($hook eq "deny");
339 } else {
340 $r[1] = "" if not defined $r[1];
89fd516 Revamp Qpsmtpd::Constants so it is possible to retrieve the text
John Peacock authored
341 $self->log(LOGDEBUG, "Plugin ".$code->{name}.
342 ", hook $hook returned ".return_code($r[0]).", $r[1]");
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
343 $self->run_hooks("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok");
344 }
5128bd0 @rspier new plugin output tracking
rspier authored
345
5eec66f @abh add deny hook (Rasjid Wilcox)
abh authored
346 }
347
bdd20fe @rspier indentation and whitespace cleanup
rspier authored
348 last unless $r[0] == DECLINED;
2fe35f1 @abh yay, plugin support works! :-D
abh authored
349 }
9d5610a @abh 0.20-dev
abh authored
350 $r[0] = DECLINED if not defined $r[0];
2fe35f1 @abh yay, plugin support works! :-D
abh authored
351 return @r;
e0d93d1 @abh semi working plugin stuff
abh authored
352 }
2fe35f1 @abh yay, plugin support works! :-D
abh authored
353 return (0, '');
354 }
355
356 sub _register_hook {
357 my $self = shift;
0e5b4e6 Add unshift parameter to register_hook, allowing you to put the hook …
Matt Sergeant authored
358 my ($hook, $code, $unshift) = @_;
e0d93d1 @abh semi working plugin stuff
abh authored
359
e6e2091 Attempt to clean up circular refs problems
Matt Sergeant authored
360 my $hooks = $self->{hooks};
0e5b4e6 Add unshift parameter to register_hook, allowing you to put the hook …
Matt Sergeant authored
361 if ($unshift) {
362 unshift @{$hooks->{$hook}}, $code;
363 }
364 else {
365 push @{$hooks->{$hook}}, $code;
366 }
e0d93d1 @abh semi working plugin stuff
abh authored
367 }
368
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored
369 sub spool_dir {
370 my $self = shift;
371
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
372 unless ( $Spool_dir ) { # first time through
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored
373 $self->log(LOGINFO, "Initializing spool_dir");
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
374 $Spool_dir = $self->config('spool_dir')
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored
375 || Qpsmtpd::Utils::tildeexp('~/tmp/');
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored
376
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
377 $Spool_dir .= "/" unless ($Spool_dir =~ m!/$!);
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored
378
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
379 $Spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly";
380 $Spool_dir = $1; # cleanse the taint
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored
381
382 # Make sure the spool dir has appropriate rights
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
383 if (-e $Spool_dir) {
384 my $mode = (stat($Spool_dir))[2];
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored
385 $self->log(LOGWARN,
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
386 "Permissions on spool_dir $Spool_dir are not 0700")
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored
387 if $mode & 07077;
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored
388 }
389
390 # And finally, create it if it doesn't already exist
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
391 -d $Spool_dir or mkdir($Spool_dir, 0700)
392 or die "Could not create spool_dir $Spool_dir: $!";
393 }
ec7aff1 * lib/Qpsmtpd.pm
John Peacock authored
394
e331f6b Add plugable logging support include sample plugin which replicates the
John Peacock authored
395 return $Spool_dir;
bb36c60 Abstracted spool_dir creation and added temp_file() and temp_dir() su…
John Peacock authored
396 }
397
398 # For unique filenames. We write to a local tmp dir so we don't need
399 # to make them unpredictable.
400 my $transaction_counter = 0;
401
402 sub temp_file {
403 my $self = shift;
404 my $filename = $self->spool_dir()
405 . join(":", time, $$, $transaction_counter++);
406 return $filename;
407 }
408
409 sub temp_dir {
410 my $self = shift;
411 my $mask = shift || 0700;
412 my $dirname = $self->temp_file();
413 -d $dirname or mkdir($dirname, $mask)
414 or die "Could not create temporary directory $dirname: $!";
415 return $dirname;
416 }
417
6df92cd @abh half baked version of the new object mail engine
abh authored
418 1;
3b7bfe9 @abh update the MANIFEST
abh authored
419
420 __END__
421
422 =head1 NAME
423
424 Qpsmtpd
425
426 =head1 DESCRIPTION
427
428 This is the base class for the qpsmtpd mail server. See
429 L<http://smtpd.develooper.com/> and the I<README> file for more information.
430
431 =head1 COPYRIGHT
432
433 Copyright 2001-2005 Ask Bjoern Hansen, Develooper LLC. See the
434 LICENSE file for more information.
435
436
437
Something went wrong with that request. Please try again.