--- trunk/Nos.pm 2005/06/21 20:49:27 59 +++ trunk/Nos.pm 2005/08/22 20:24:04 72 @@ -16,7 +16,7 @@ our @EXPORT = qw( ); -our $VERSION = '0.5'; +our $VERSION = '0.7'; use Class::DBI::Loader; use Email::Valid; @@ -27,6 +27,8 @@ use Email::Address; use Mail::DeliveryStatus::BounceParser; use Class::DBI::AbstractSearch; +use Mail::Alias; +use Cwd qw(abs_path); =head1 NAME @@ -40,7 +42,39 @@ =head1 DESCRIPTION -Core module for notice sender's functionality. +Notice sender is mail handler. It is not MTA, since it doesn't know how to +receive e-mails or send them directly to other hosts. It is not mail list +manager because it requires programming to add list members and send +messages. You can think of it as mechanisam for off-loading your e-mail +sending to remote server using SOAP service. + +It's concept is based around B. Each list can have zero or more +B. Each list can have zero or more B. + +Here comes a twist: each outgoing message will have unique e-mail generated, +so Notice Sender will be able to link received replies (or bounces) with +outgoing messages. + +It doesn't do much more than that. It B create MIME encoded e-mail, +send attachments, handle 8-bit characters in headers (which have to be +encoded) or anything else. + +It will just queue your e-mail message to particular list (sending it to +possibly remote Notice Sender SOAP server just once), send it out at +reasonable rate (so that it doesn't flood your e-mail infrastructure) and +track replies. + +It is best used to send smaller number of messages to more-or-less fixed +list of recipients while allowing individual responses to be examined. +Tipical use include replacing php e-mail sending code with SOAP call to +Notice Sender. It does support additional C field for each member +which can be used to track some unique identifier from remote system for +particular user. + +It comes with command-line utility C which can be used to perform +all available operation from scripts (see C). +This command is also useful for debugging while writing client SOAP +application. =head1 METHODS @@ -86,24 +120,26 @@ } -=head2 new_list +=head2 create_list -Create new list. Required arguments are name of C and -C address. +Create new list. Required arguments are name of C, C address +and path to C file. - $nos->new_list( + $nos->create_list( list => 'My list', from => 'Outgoing from comment', email => 'my-list@example.com', + aliases => '/etc/mail/mylist', + archive => '/path/to/mbox/archive', ); Returns ID of newly created list. -Calls internally L<_add_list>, see details there. +Calls internally C<_add_list>, see details there. =cut -sub new_list { +sub create_list { my $self = shift; my $arg = {@_}; @@ -122,6 +158,42 @@ } +=head2 drop_list + +Delete list from database. + + my $ok = drop_list( + list => 'My list' + aliases => '/etc/mail/mylist', + ); + +Returns false if list doesn't exist. + +=cut + +sub drop_list { + my $self = shift; + + my $args = {@_}; + + croak "need list to delete" unless ($args->{'list'}); + + $args->{'list'} = lc($args->{'list'}); + + my $aliases = $args->{'aliases'} || croak "need path to aliases file"; + + my $lists = $self->{'loader'}->find_class('lists'); + + my $this_list = $lists->search( name => $args->{'list'} )->first || return; + + $self->_remove_alias( email => $this_list->email, aliases => $aliases); + + $this_list->delete || croak "can't delete list\n"; + + return $lists->dbi_commit || croak "can't commit"; +} + + =head2 add_member_to_list Add new member to list @@ -203,7 +275,7 @@ } If list is not found, returns false. If there is C in user data, -that will also be returned. +it will also be returned. =cut @@ -252,6 +324,9 @@ Returns false if user doesn't exist. +This function will delete member from all lists (by cascading delete), so it +shouldn't be used lightly. + =cut sub delete_member { @@ -308,7 +383,7 @@ my $this_user = $user->search( email => $args->{'email'} )->first || croak "can't find user: ".$args->{'email'}; my $this_list = $list->search( name => $args->{'list'} )->first || croak "can't find list: ".$args->{'list'}; - my $this_user_list = $user_list->search_where( list_id => $this_list->id, user_id => $this_list->id )->first || return; + my $this_user_list = $user_list->search_where( list_id => $this_list->id, user_id => $this_user->id )->first || return; $this_user_list->delete || croak "can't delete user from list\n"; @@ -454,7 +529,7 @@ if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) { print "SKIP $to_email message allready sent\n"; } else { - print "=> $to_email\n"; + print "=> $to_email "; my $secret = $m->list_id->name . " " . $u->user_id->email . " " . $m->message_id; my $auth = Email::Auth::AddressHash->new( $secret, $self->{'hash_len'} ); @@ -480,18 +555,32 @@ $m_obj->header_set('X-Nos-Hash', $hash); # really send e-mail + my $sent_status; + if (@email_send_options) { - send $email_send_driver => $m_obj->as_string, @email_send_options; + $sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options; } else { - send $email_send_driver => $m_obj->as_string; + $sent_status = send $email_send_driver => $m_obj->as_string; } - $sent->create({ - message_id => $m->message_id, - user_id => $u->user_id, - hash => $hash, - }); - $sent->dbi_commit; + croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status); + my @bad = @{ $sent_status->prop('bad') }; + croak "failed sending to ",join(",",@bad) if (@bad); + + if ($sent_status) { + + $sent->create({ + message_id => $m->message_id, + user_id => $u->user_id, + hash => $hash, + }); + $sent->dbi_commit; + + print " - $sent_status\n"; + + } else { + warn "ERROR: $sent_status\n"; + } if ($sleep) { warn "sleeping $sleep seconds\n"; @@ -515,6 +604,8 @@ message => $message, ); +This method is used by C when receiving e-mail messages. + =cut sub inbox_message { @@ -605,6 +696,81 @@ Beware of dragons! You shouldn't need to call those methods directly. + +=head2 _add_aliases + +Add or update alias in C (or equivalent) file for selected list + + my $ok = $nos->add_aliases( + list => 'My list', + email => 'my-list@example.com', + aliases => '/etc/mail/mylist', + archive => '/path/to/mbox/archive', + + ); + +C parametar is optional. + +Return false on failure. + +=cut + +sub _add_aliases { + my $self = shift; + + my $arg = {@_}; + + foreach my $o (qw/list email aliases/) { + croak "need $o option" unless ($arg->{$o}); + } + + my $aliases = $arg->{'aliases'}; + my $email = $arg->{'email'}; + my $list = $arg->{'list'}; + + unless (-e $aliases) { + warn "aliases file $aliases doesn't exist, creating empty\n"; + open(my $fh, '>', $aliases) || croak "can't create $aliases: $!"; + close($fh); + chmod 0777, $aliases || warn "can't change permission to 0777"; + } + + die "FATAL: aliases file $aliases is not writable\n" unless (-w $aliases); + + my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!"; + + my $target = ''; + + if (my $archive = $arg->{'archive'}) { + $target .= "$archive, "; + + if (! -e $archive) { + warn "please make sure that file $archive is writable for your e-mail user (defaulting to bad 777 permission for now)"; + + open(my $fh, '>', $archive) || croak "can't create archive file $archive: $!"; + close($fh); + chmod 0777, $archive || croak "can't chmod archive file $archive to 0777: $!"; + } + } + + # resolve my path to absolute one + my $self_path = abs_path($0); + $self_path =~ s#/[^/]+$##; + $self_path =~ s#/t/*$#/#; + + $target .= qq#| cd $self_path && ./sender.pl --inbox="$list"#; + + if ($a->exists($email)) { + $a->update($email, $target) or croak "can't update alias ".$a->error_check; + } else { + $a->append($email, $target) or croak "can't add alias ".$a->error_check; + } + + #$a->write($aliases) or croak "can't save aliases $aliases ".$a->error_check; + + return 1; +} + =head2 _add_list Create new list @@ -613,6 +779,7 @@ list => 'My list', from => 'Outgoing from comment', email => 'my-list@example.com', + aliases => '/etc/mail/mylist', ); Returns C object for created list. @@ -631,10 +798,18 @@ my $name = lc($arg->{'list'}) || confess "can't add list without name"; my $email = lc($arg->{'email'}) || confess "can't add list without e-mail"; + my $aliases = lc($arg->{'aliases'}) || confess "can't add list without path to aliases file"; + my $from_addr = $arg->{'from'}; my $lists = $self->{'loader'}->find_class('lists'); + $self->_add_aliases( + list => $name, + email => $email, + aliases => $aliases, + ) || warn "can't add alias $email for list $name"; + my $l = $lists->find_or_create({ name => $name, email => $email, @@ -654,6 +829,7 @@ } + =head2 _get_list Get list C object. @@ -674,6 +850,40 @@ return $lists->search({ name => lc($name) })->first; } + +=head2 _remove_alias + +Remove list alias + + my $ok = $nos->_remove_alias( + email => 'mylist@example.com', + aliases => '/etc/mail/mylist', + ); + +Returns true if list is removed or false if list doesn't exist. Dies in case of error. + +=cut + +sub _remove_alias { + my $self = shift; + + my $arg = {@_}; + + my $email = lc($arg->{'email'}) || confess "can't remove alias without email"; + my $aliases = lc($arg->{'aliases'}) || confess "can't remove alias without list"; + + my $a = new Mail::Alias($aliases) || croak "can't open aliases file $aliases: $!"; + + if ($a->exists($email)) { + $a->delete($email) || croak "can't remove alias $email"; + } else { + return 0; + } + + return 1; + +} + ### ### SOAP ### @@ -698,9 +908,29 @@ my $nos; + +=head2 new + +Create new SOAP object + + my $soap = new Nos::SOAP( + dsn => 'dbi:Pg:dbname=notices', + user => 'dpavlin', + passwd => '', + debug => 1, + verbose => 1, + hash_len => 8, + aliases => '/etc/aliases', + ); + +=cut + sub new { my $class = shift; my $self = {@_}; + + croak "need aliases parametar" unless ($self->{'aliases'}); + bless($self, $class); $nos = new Nos( @_ ) || die "can't create Nos object"; @@ -709,9 +939,9 @@ } -=head2 NewList +=head2 CreateList - $message_id = NewList( + $message_id = CreateList( list => 'My list', from => 'Name of my list', email => 'my-list@example.com' @@ -719,19 +949,45 @@ =cut -sub NewList { +sub CreateList { my $self = shift; + my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor"; + if ($_[0] !~ m/^HASH/) { - return $nos->new_list( + return $nos->create_list( list => $_[0], from => $_[1], email => $_[2], + aliases => $aliases, ); } else { - return $nos->new_list( %{ shift @_ } ); + return $nos->create_list( %{ shift @_ }, aliases => $aliases ); } } +=head2 DropList + + $ok = DropList( + list => 'My list', + ); + +=cut + +sub DropList { + my $self = shift; + + my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor"; + + if ($_[0] !~ m/^HASH/) { + return $nos->drop_list( + list => $_[0], + aliases => $aliases, + ); + } else { + return $nos->drop_list( %{ shift @_ }, aliases => $aliases ); + } +} + =head2 AddMemberToList $member_id = AddMemberToList( @@ -764,6 +1020,10 @@ Returns array of hashes with user informations, see C. +Returning arrays from SOAP calls is somewhat fuzzy (at least to me). It +seems that SOAP::Lite client thinks that it has array with one element which +is array of hashes with data. + =cut sub ListMembers { @@ -777,9 +1037,32 @@ $list_name = $_[0]->{'list'}; } - return $nos->list_members( list => $list_name ); + return [ $nos->list_members( list => $list_name ) ]; } + +=head2 DeleteMemberFromList + + $member_id = DeleteMemberFromList( + list => 'My list', + email => 'e-mail@example.com', + ); + +=cut + +sub DeleteMemberFromList { + my $self = shift; + + if ($_[0] !~ m/^HASH/) { + return $nos->delete_member_from_list( + list => $_[0], email => $_[1], + ); + } else { + return $nos->delete_member_from_list( %{ shift @_ } ); + } +} + + =head2 AddMessageToList $message_id = AddMessageToList(