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;
|
2004-03-14 23:35:51 +01:00
|
|
|
use Qpsmtpd::Constants;
|
2002-09-24 12:56:35 +02:00
|
|
|
|
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;
|
2004-09-16 12:46:38 +02:00
|
|
|
@_ and $self->{_recipients} = [@_];
|
2002-07-04 03:45:19 +02:00
|
|
|
($self->{_recipients} ? @{$self->{_recipients}} : ());
|
2002-07-03 15:10:44 +02:00
|
|
|
}
|
|
|
|
|
2004-06-16 22:28:57 +02:00
|
|
|
sub relaying {
|
|
|
|
my $self = shift;
|
|
|
|
@_ and $self->{_relaying} = shift;
|
|
|
|
$self->{_relaying};
|
|
|
|
}
|
|
|
|
|
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
|
|
|
|
2004-07-16 07:04:25 +02:00
|
|
|
sub body_filename {
|
|
|
|
my $self = shift;
|
|
|
|
return unless $self->{_body_file};
|
|
|
|
return $self->{_filename};
|
|
|
|
}
|
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];
|
2004-06-28 02:00:51 +02:00
|
|
|
die "Permissions on spool_dir $spool_dir are not 0700" if $mode & 07077;
|
2003-04-21 10:23:35 +02:00
|
|
|
}
|
2002-09-24 12:56:35 +02:00
|
|
|
|
2004-06-28 01:39:32 +02:00
|
|
|
-d $spool_dir or mkdir($spool_dir, 0700) or die "Could not create spool_dir $spool_dir: $!";
|
2002-09-24 12:56:35 +02:00
|
|
|
$self->{_filename} = $spool_dir . join(":", time, $$, $transaction_counter++);
|
|
|
|
$self->{_filename} =~ tr!A-Za-z0-9:/_-!!cd;
|
2004-04-21 14:42:45 +02:00
|
|
|
$self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT, 0600)
|
2002-08-06 14:01:22 +02:00
|
|
|
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}) {
|
2004-03-05 13:46:24 +01:00
|
|
|
unlink $self->{_filename} or $self->log(LOGERROR, "Could not unlink ", $self->{_filename}, ": $!");
|
2002-08-06 15:04:51 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2002-07-03 15:10:44 +02:00
|
|
|
1;
|
2003-06-09 15:45:29 +02:00
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
|
|
Qpsmtpd::Transaction - single SMTP session transaction data
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
foreach my $recip ($transaction->recipients) {
|
|
|
|
print "T", $recip->address, "\0";
|
|
|
|
}
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
Qpsmtpd::Transaction maintains a single SMTP session's data, including
|
|
|
|
the envelope details and the mail header and body.
|
|
|
|
|
|
|
|
The docs below cover using the C<$transaction> object from within plugins
|
|
|
|
rather than constructing a C<Qpsmtpd::Transaction> object, because the
|
|
|
|
latter is done for you by qpsmtpd.
|
|
|
|
|
|
|
|
=head1 API
|
|
|
|
|
|
|
|
=head2 add_recipient($recipient)
|
|
|
|
|
|
|
|
This adds a new recipient (as in RCPT TO) to the envelope of the mail.
|
|
|
|
|
2004-07-15 01:58:47 +02:00
|
|
|
The C<$recipient> is a C<Qpsmtpd::Address> object. See L<Qpsmtpd::Address>
|
2003-06-09 15:45:29 +02:00
|
|
|
for more details.
|
|
|
|
|
2004-06-07 20:48:52 +02:00
|
|
|
=head2 recipients( )
|
2003-06-09 15:45:29 +02:00
|
|
|
|
|
|
|
This returns a list of the current recipients in the envelope.
|
|
|
|
|
2004-07-15 01:58:47 +02:00
|
|
|
Each recipient returned is a C<Qpsmtpd::Address> object.
|
2003-06-09 15:45:29 +02:00
|
|
|
|
2004-09-16 12:46:38 +02:00
|
|
|
This method is also a setter. Pass in a list of recipients to change
|
|
|
|
the recipient list to an entirely new list. Note that the recipients
|
|
|
|
you pass in B<MUST> be C<Qpsmtpd::Address> objects.
|
|
|
|
|
2004-06-16 22:28:57 +02:00
|
|
|
=head2 relaying( )
|
|
|
|
|
|
|
|
Returns true if this mail transaction is relaying. This value is set
|
|
|
|
by the C<check_relay> plugin.
|
|
|
|
|
2003-06-09 15:45:29 +02:00
|
|
|
=head2 sender( [ ADDRESS ] )
|
|
|
|
|
|
|
|
Get or set the sender (MAIL FROM) address in the envelope.
|
|
|
|
|
2004-07-15 01:58:47 +02:00
|
|
|
The sender is a C<Qpsmtpd::Address> object.
|
2003-06-09 15:45:29 +02:00
|
|
|
|
|
|
|
=head2 header( [ HEADER ] )
|
|
|
|
|
|
|
|
Get or set the header of the email.
|
|
|
|
|
|
|
|
The header is a <Mail::Header> object, which gives you access to all
|
|
|
|
the individual headers using a simple API. e.g.:
|
|
|
|
|
|
|
|
my $headers = $transaction->header();
|
|
|
|
my $msgid = $headers->get('Message-Id');
|
|
|
|
my $subject = $headers->get('Subject');
|
|
|
|
|
|
|
|
=head2 notes( $key [, $value ] )
|
|
|
|
|
|
|
|
Get or set a note on the transaction. This is a piece of data that you wish
|
|
|
|
to attach to the transaction and read somewhere else. For example you can
|
|
|
|
use this to pass data between plugins.
|
|
|
|
|
2003-06-10 12:15:42 +02:00
|
|
|
Note though that these notes will be lost when a transaction ends, for
|
|
|
|
example on a C<RSET> or after C<DATA> completes, so you might want to
|
|
|
|
use the notes field in the C<Qpsmtpd::Connection> object instead.
|
2003-06-09 15:45:29 +02:00
|
|
|
|
2004-07-16 07:04:25 +02:00
|
|
|
=head2 body_filename ( )
|
|
|
|
|
|
|
|
Returns the temporary filename used to store the message contents; useful for
|
|
|
|
virus scanners so that an additional copy doesn't need to be made.
|
|
|
|
|
2003-06-09 15:45:29 +02:00
|
|
|
=head2 body_write( $data )
|
|
|
|
|
|
|
|
Write data to the end of the email.
|
|
|
|
|
|
|
|
C<$data> can be either a plain scalar, or a reference to a scalar.
|
|
|
|
|
2004-06-07 20:48:52 +02:00
|
|
|
=head2 body_size( )
|
2003-06-09 15:45:29 +02:00
|
|
|
|
|
|
|
Get the current size of the email.
|
|
|
|
|
2004-06-07 20:48:52 +02:00
|
|
|
=head2 body_resetpos( )
|
2003-06-09 15:45:29 +02:00
|
|
|
|
|
|
|
Resets the body filehandle to the start of the file (via C<seek()>).
|
|
|
|
|
|
|
|
Use this function before every time you wish to process the entire
|
|
|
|
body of the email to ensure that some other plugin has not moved the
|
|
|
|
file pointer.
|
|
|
|
|
2004-06-07 20:48:52 +02:00
|
|
|
=head2 body_getline( )
|
2003-06-09 15:45:29 +02:00
|
|
|
|
|
|
|
Returns a single line of data from the body of the email.
|
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
2004-07-15 01:58:47 +02:00
|
|
|
L<Mail::Header>, L<Qpsmtpd::Address>, L<Qpsmtpd::Connection>
|
2003-06-09 15:45:29 +02:00
|
|
|
|
|
|
|
=cut
|