2002-07-03 15:10:44 +02:00
|
|
|
package Qpsmtpd::Transaction;
|
2002-09-24 12:56:35 +02:00
|
|
|
use Qpsmtpd;
|
|
|
|
@ISA = qw(Qpsmtpd);
|
2002-07-03 15:10:44 +02:00
|
|
|
use strict;
|
2002-09-24 12:56:35 +02:00
|
|
|
use Qpsmtpd::Utils;
|
|
|
|
|
2002-08-06 14:01:22 +02:00
|
|
|
use IO::File qw(O_RDWR O_CREAT);
|
|
|
|
|
|
|
|
# For unique filenames. We write to a local tmp dir so we don't need
|
|
|
|
# to make them unpredictable.
|
|
|
|
my $transaction_counter = 0;
|
2002-07-03 15:10:44 +02:00
|
|
|
|
|
|
|
sub new { start(@_) }
|
|
|
|
|
|
|
|
sub start {
|
|
|
|
my $proto = shift;
|
|
|
|
my $class = ref($proto) || $proto;
|
|
|
|
my %args = @_;
|
2002-07-04 03:45:19 +02:00
|
|
|
my $self = { _rcpt => [], started => time };
|
2002-07-03 15:10:44 +02:00
|
|
|
bless ($self, $class);
|
|
|
|
}
|
|
|
|
|
|
|
|
sub add_recipient {
|
|
|
|
my $self = shift;
|
2002-07-04 03:45:19 +02:00
|
|
|
@_ and push @{$self->{_recipients}}, shift;
|
|
|
|
}
|
2002-07-03 15:10:44 +02:00
|
|
|
|
2002-07-04 03:45:19 +02:00
|
|
|
sub recipients {
|
|
|
|
my $self = shift;
|
|
|
|
($self->{_recipients} ? @{$self->{_recipients}} : ());
|
2002-07-03 15:10:44 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
sub sender {
|
|
|
|
my $self = shift;
|
|
|
|
@_ and $self->{_sender} = shift;
|
|
|
|
$self->{_sender};
|
2002-07-06 04:09:01 +02:00
|
|
|
}
|
2002-07-03 15:10:44 +02:00
|
|
|
|
2002-07-06 04:09:01 +02:00
|
|
|
sub header {
|
|
|
|
my $self = shift;
|
|
|
|
@_ and $self->{_header} = shift;
|
|
|
|
$self->{_header};
|
2002-07-03 15:10:44 +02:00
|
|
|
}
|
|
|
|
|
2002-09-08 12:05:36 +02:00
|
|
|
# blocked() will return when we actually can do something useful with it...
|
|
|
|
#sub blocked {
|
2002-08-06 14:01:22 +02:00
|
|
|
# my $self = shift;
|
2002-09-08 12:05:36 +02:00
|
|
|
# carp 'Use of transaction->blocked is deprecated;'
|
|
|
|
# . 'tell ask@develooper.com if you have a reason to use it';
|
|
|
|
# @_ and $self->{_blocked} = shift;
|
|
|
|
# $self->{_blocked};
|
2002-08-06 14:01:22 +02:00
|
|
|
#}
|
2002-07-04 03:45:19 +02:00
|
|
|
|
2002-07-08 04:30:11 +02:00
|
|
|
sub notes {
|
|
|
|
my $self = shift;
|
|
|
|
my $key = shift;
|
|
|
|
@_ and $self->{_notes}->{$key} = shift;
|
2003-04-21 10:23:35 +02:00
|
|
|
#warn Data::Dumper->Dump([\$self->{_notes}], [qw(notes)]);
|
2002-07-08 04:30:11 +02:00
|
|
|
$self->{_notes}->{$key};
|
|
|
|
}
|
2002-07-04 03:45:19 +02:00
|
|
|
|
2002-08-06 14:01:22 +02:00
|
|
|
sub add_header_line {
|
|
|
|
my $self = shift;
|
|
|
|
$self->{_header} .= shift;
|
|
|
|
}
|
2002-07-06 04:09:01 +02:00
|
|
|
|
2002-08-06 14:01:22 +02:00
|
|
|
sub body_write {
|
|
|
|
my $self = shift;
|
|
|
|
my $data = shift;
|
|
|
|
unless ($self->{_body_file}) {
|
2002-09-24 12:56:35 +02:00
|
|
|
my $spool_dir = $self->config('spool_dir') ? $self->config('spool_dir')
|
|
|
|
: Qpsmtpd::Utils::tildeexp('~/tmp/');
|
|
|
|
|
|
|
|
$spool_dir .= "/" unless ($spool_dir =~ m!/$!);
|
2003-04-21 10:23:35 +02:00
|
|
|
|
|
|
|
$spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly";
|
|
|
|
$spool_dir = $1;
|
|
|
|
|
|
|
|
if (-e $spool_dir) {
|
|
|
|
my $mode = (stat($spool_dir))[2];
|
|
|
|
die "Permissions on the spool_dir are not 0700" if $mode & 07077;
|
|
|
|
}
|
2002-09-24 12:56:35 +02:00
|
|
|
|
|
|
|
-d $spool_dir or mkdir($spool_dir, 0700) or die "Could not create spool_dir: $!";
|
|
|
|
$self->{_filename} = $spool_dir . join(":", time, $$, $transaction_counter++);
|
|
|
|
$self->{_filename} =~ tr!A-Za-z0-9:/_-!!cd;
|
2002-08-06 14:01:22 +02:00
|
|
|
$self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT)
|
|
|
|
or die "Could not open file $self->{_filename} - $! "; # . $self->{_body_file}->error;
|
|
|
|
}
|
|
|
|
# go to the end of the file
|
|
|
|
seek($self->{_body_file},0,2)
|
|
|
|
unless $self->{_body_file_writing};
|
|
|
|
$self->{_body_file_writing} = 1;
|
2002-08-06 14:57:59 +02:00
|
|
|
$self->{_body_file}->print(ref $data eq "SCALAR" ? $$data : $data)
|
|
|
|
and $self->{_body_size} += length (ref $data eq "SCALAR" ? $$data : $data);
|
|
|
|
}
|
|
|
|
|
|
|
|
sub body_size {
|
|
|
|
shift->{_body_size} || 0;
|
2002-08-06 14:01:22 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
sub body_resetpos {
|
|
|
|
my $self = shift;
|
|
|
|
return unless $self->{_body_file};
|
|
|
|
seek($self->{_body_file}, 0,0);
|
|
|
|
$self->{_body_file_writing} = 0;
|
|
|
|
1;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub body_getline {
|
|
|
|
my $self = shift;
|
|
|
|
return unless $self->{_body_file};
|
|
|
|
seek($self->{_body_file}, 0,0)
|
|
|
|
if $self->{_body_file_writing};
|
|
|
|
$self->{_body_file_writing} = 0;
|
|
|
|
my $line = $self->{_body_file}->getline;
|
|
|
|
return $line;
|
|
|
|
|
|
|
|
}
|
2002-07-04 03:45:19 +02:00
|
|
|
|
2002-08-06 15:04:51 +02:00
|
|
|
sub DESTROY {
|
|
|
|
my $self = shift;
|
|
|
|
# would we save some disk flushing if we unlinked the file before
|
|
|
|
# closing it?
|
|
|
|
|
|
|
|
undef $self->{_body_file} if $self->{_body_file};
|
|
|
|
if ($self->{_filename} and -e $self->{_filename}) {
|
|
|
|
unlink $self->{_filename} or $self->log(0, "Could not unlink ", $self->{_filename}, ": $!");
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2002-07-03 15:10:44 +02:00
|
|
|
1;
|