--- trunk/Nos.pm	2005/05/15 22:12:31	23
+++ trunk/Nos.pm	2006/12/18 18:55:43	89
@@ -16,12 +16,21 @@
 our @EXPORT = qw( 
 );
 
-our $VERSION = '0.1';
+our $VERSION = '0.8';
 
 use Class::DBI::Loader;
 use Email::Valid;
 use Email::Send;
 use Carp;
+use Email::Auth::AddressHash;
+use Email::Simple;
+use Email::Address;
+use Mail::DeliveryStatus::BounceParser;
+use Class::DBI::AbstractSearch;
+use SQL::Abstract;
+use Mail::Alias;
+use Cwd qw(abs_path);
+
 
 =head1 NAME
 
@@ -34,7 +43,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<lists>. Each list can have zero or more
+B<members>. Each list can have zero or more B<messages>.
+
+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<can't> 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
+keep track replies.
+
+It is best used to send small 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<ext_id> 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<sender.pl> which can be used to perform
+all available operation from scripts (see C<sender.pl --man>).
+This command is also useful for debugging while writing client SOAP
+application.
 
 =head1 METHODS
 
@@ -48,13 +89,22 @@
 	passwd => '',
 	debug => 1,
 	verbose => 1,
+	hash_len => 8,
+	full_hostname_in_aliases => 0,
  );
 
+Parametar C<hash_len> defines length of hash which will be added to each
+outgoing e-mail message to ensure that replies can be linked with sent e-mails.
+
+C<full_hostname_in_aliases> will turn on old behaviour (not supported by Postfix
+postalias) to include full hostname in aliases file.
+
+
 =cut
 
 sub new {
-        my $class = shift;
-        my $self = {@_};
+	my $class = shift;
+	my $self = {@_};
 	bless($self, $class);
 
 	croak "need at least dsn" unless ($self->{'dsn'});
@@ -65,14 +115,91 @@
 		user		=> $self->{'user'},
 		password	=> $self->{'passwd'},
 		namespace	=> "Nos",
-#		additional_classes      => qw/Class::DBI::AbstractSearch/,
+		additional_classes      => qw/Class::DBI::AbstractSearch/,
 #		additional_base_classes => qw/My::Stuff/,
 		relationships	=> 1,
 	) || croak "can't init Class::DBI::Loader";
 
+	$self->{'hash_len'} ||= 8;
+
 	$self ? return $self : return undef;
 }
 
+
+=head2 create_list
+
+Create new list. Required arguments are name of C<list>, C<email> address
+and path to C<aliases> file.
+
+ $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 C<_add_list>, see details there.
+
+=cut
+
+sub create_list {
+	my $self = shift;
+
+	my $arg = {@_};
+
+	confess "need list name" unless ($arg->{'list'});
+	confess "need list email" unless ($arg->{'email'});
+
+	$arg->{'list'} = lc($arg->{'list'});
+	$arg->{'email'} = lc($arg->{'email'});
+
+	my $l = $self->_get_list($arg->{'list'}) ||
+		$self->_add_list( @_ ) ||
+		return undef;
+
+	return $l->id;
+}
+
+
+=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
@@ -81,11 +208,12 @@
  	list => "My list",
 	email => "john.doe@example.com",
 	name => "John A. Doe",
+	ext_id => 42,
  );
 
-C<name> parametar is optional.
+C<name> and C<ext_id> parametars are optional.
 
-Return true if user is added.
+Return member ID if user is added.
 
 =cut
 
@@ -94,30 +222,37 @@
 
 	my $arg = {@_};
 
-	my $email = $arg->{'email'} || confess "can't add user without e-mail";
+	my $email = lc($arg->{'email'}) || croak "can't add user without e-mail";
 	my $name = $arg->{'name'} || '';
-	confess "need list name" unless ($arg->{'list'});
+	my $list_name = lc($arg->{'list'}) || croak "need list name";
+	my $ext_id = $arg->{'ext_id'};
+
+	my $list = $self->_get_list($list_name) || croak "list $list_name doesn't exist";
 
 	if (! Email::Valid->address($email)) {
-		warn "SKIPPING $name <$email>";
+		carp "SKIPPING $name <$email>\n";
 		return 0;
 	}
 
-	print "# $name <$email>\n";
+	carp "# $name <$email>\n" if ($self->{'verbose'});
 
-	my $lists = $self->{'loader'}->find_class('lists');
 	my $users = $self->{'loader'}->find_class('users');
 	my $user_list = $self->{'loader'}->find_class('user_list');
 
-	my $list = $lists->find_or_create({
-		name => $arg->{'list'},
-	}) || croak "can't add list ",$arg->{'list'},"\n";
-	
 	my $this_user = $users->find_or_create({
 		email => $email,
-		full_name => $name,
 	}) || croak "can't find or create member\n";
 
+	if ($name && $this_user->name ne $name) {
+		$this_user->name($name || '');
+		$this_user->update;
+	}
+
+	if (defined($ext_id) && ($this_user->ext_id || '') ne $ext_id) {
+		$this_user->ext_id($ext_id);
+		$this_user->update;
+	}
+
 	my $user_on_list = $user_list->find_or_create({
 		user_id => $this_user->id,
 		list_id => $list->id,
@@ -127,21 +262,254 @@
 	$this_user->dbi_commit;
 	$user_on_list->dbi_commit;
 
-	return 1;
+	return $this_user->id;
+}
+
+=head2 list_members
+
+List all members of some list.
+
+ my @members = list_members(
+ 	list => 'My list',
+ );
+
+Returns array of hashes with user information like this:
+
+ $member = {
+ 	name => 'Dobrica Pavlinusic',
+	email => 'dpavlin@rot13.org
+ }
+
+If list is not found, returns false. If there is C<ext_id> in user data,
+it will also be returned.
+
+=cut
+
+sub list_members {
+	my $self = shift;
+
+	my $args = {@_};
+
+	my $list_name = lc($args->{'list'}) || confess "need list name";
+
+	my $lists = $self->{'loader'}->find_class('lists');
+	my $user_list = $self->{'loader'}->find_class('user_list');
+
+	my $this_list = $lists->search( name => $list_name )->first || return;
+
+	my @results;
+
+	foreach my $user_on_list ($user_list->search(list_id => $this_list->id)) {
+		my $row = {
+			name => $user_on_list->user_id->name,
+			email => $user_on_list->user_id->email,
+		};
+
+		my $ext_id = $user_on_list->user_id->ext_id;
+		$row->{'ext_id'} = $ext_id if (defined($ext_id));
+
+		push @results, $row;
+	}
+
+	return @results;
+
+}
+
+
+=head2 delete_member
+
+Delete member from database.
+
+ my $ok = delete_member(
+ 	name => 'Dobrica Pavlinusic'
+ );
+
+ my $ok = delete_member(
+ 	email => 'dpavlin@rot13.org'
+ );
+
+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 {
+	my $self = shift;
+
+	my $args = {@_};
+
+	croak "need name or email of user to delete" unless ($args->{'name'} || $args->{'email'});
+
+	$args->{'email'} = lc($args->{'email'}) if ($args->{'email'});
+
+	my $key = 'name';
+	$key = 'email' if ($args->{'email'});
+
+	my $users = $self->{'loader'}->find_class('users');
+
+	my $this_user = $users->search( $key => $args->{$key} )->first || return;
+
+	$this_user->delete || croak "can't delete user\n";
+
+	return $users->dbi_commit || croak "can't commit";
+}
+
+=head2 delete_member_from_list
+
+Delete member from particular list.
+
+ my $ok = delete_member_from_list(
+ 	list => 'My list',
+ 	email => 'dpavlin@rot13.org',
+ );
+
+Returns false if user doesn't exist on that particular list.
+
+It will die if list or user doesn't exist. You have been warned (you might
+want to eval this functon to prevent it from croaking).
+
+=cut
+
+sub delete_member_from_list {
+	my $self = shift;
+
+	my $args = {@_};
+
+	croak "need list name and email of user to delete" unless ($args->{'list'} && $args->{'email'});
+
+	$args->{'list'} = lc($args->{'list'});
+	$args->{'email'} = lc($args->{'email'});
+
+	my $user = $self->{'loader'}->find_class('users');
+	my $list = $self->{'loader'}->find_class('lists');
+	my $user_list = $self->{'loader'}->find_class('user_list');
+
+	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_user->id )->first || return;
+
+	$this_user_list->delete || croak "can't delete user from list\n";
+
+	return $user_list->dbi_commit || croak "can't commit";
+}
+
+=head2 add_message_to_list
+
+Adds message to one list's queue for later sending.
+
+ $nos->add_message_to_list(
+ 	list => 'My list',
+ 	message => 'Subject: welcome to list
+
+ This is example message
+ ',
+ );	
+
+On success returns ID of newly created (or existing) message.
+
+Only required header in e-mail is C<Subject:>. C<From:> and C<To:> headers
+will be automatically generated, but if you want to use own headers, just
+include them in messages.
+
+=cut
+
+sub add_message_to_list {
+	my $self = shift;
+
+	my $args = {@_};
+
+	my $list_name = lc($args->{'list'}) || confess "need list name";
+	my $message_text = $args->{'message'} || croak "need message";
+
+	my $m = Email::Simple->new($message_text) || croak "can't parse message";
+
+	warn "message doesn't have Subject header\n" unless( $m->header('Subject') );
+
+	my $lists = $self->{'loader'}->find_class('lists');
+
+	my $this_list = $lists->search(
+		name => $list_name,
+	)->first || croak "can't find list $list_name";
+
+	my $messages = $self->{'loader'}->find_class('messages');
+
+	my $this_message = $messages->find_or_create({
+		message => $message_text
+	}) || croak "can't insert message";
+
+	$this_message->dbi_commit() || croak "can't add message";
+
+	my $queue = $self->{'loader'}->find_class('queue');
+
+	$queue->find_or_create({
+		message_id => $this_message->id,
+		list_id => $this_list->id,
+	}) || croak "can't add message ",$this_message->id," to list ",$this_list->id, ": ",$this_list->name;
+
+	$queue->dbi_commit || croak "can't add message to list ",$this_list->name;
+
+	return $this_message->id;
 }
 
+
 =head2 send_queued_messages
 
 Send queued messages or just ones for selected list
 
- $noc->send_queued_messages("my list");
+ $nos->send_queued_messages(
+ 	list => 'My list',
+	driver => 'smtp',
+	sleep => 3,
+ );
+
+Second option is driver which will be used for e-mail delivery. If not
+specified, C<IO> driver will be used which will dump e-mail to C<STDERR>.
+
+Other valid drivers are:
+
+=over 10
+
+=item smtp
+
+Send e-mail using SMTP server at 127.0.0.1
+
+=back
+
+Any other driver name will try to use C<Email::Send::that_driver> module.
+
+Default sleep wait between two messages is 3 seconds.
+
+This method will return number of succesfully sent messages.
 
 =cut
 
 sub send_queued_messages {
 	my $self = shift;
 
-	my $list_name = shift;
+	my $arg = {@_};
+
+	my $list_name = lc($arg->{'list'}) || '';
+	my $driver = $arg->{'driver'} || '';
+	my $sleep = $arg->{'sleep'};
+	$sleep ||= 3 unless defined($sleep);
+
+	# number of messages sent o.k.
+	my $ok = 0;
+
+	my $email_send_driver = 'Email::Send::IO';
+	my @email_send_options;
+
+	if (lc($driver) eq 'smtp') {
+		$email_send_driver = 'Email::Send::SMTP';
+		@email_send_options = ['127.0.0.1'];
+	} elsif ($driver && $driver ne '') {
+		$email_send_driver = 'Email::Send::' . $driver;
+	} else {
+		warn "dumping all messages to STDERR\n";
+	}
 
 	my $lists = $self->{'loader'}->find_class('lists');
 	my $queue = $self->{'loader'}->find_class('queue');
@@ -166,22 +534,72 @@
 
 		foreach my $u ($user_list->search(list_id => $m->list_id)) {
 
+			my $to_email = $u->user_id->email;
+
+			my ($from,$domain) = split(/@/, $u->list_id->email, 2);
+
 			if ($sent->search( message_id => $m->message_id, user_id => $u->user_id )) {
-				print "SKIP ",$u->user_id->email," message allready sent\n";
+				print "SKIP $to_email message allready sent\n";
 			} else {
-				print "\t",$u->user_id->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'} );
+
+				my $hash = $auth->generate_hash( $to_email );
+
+				my $from_addr;
+				my $from_email_only = $from . "+" . $hash . ( $domain ? '@' . $domain : '');
+
+				$from_addr .= '"' . $u->list_id->from_addr . '" ' if ($u->list_id->from_addr);
+				$from_addr .= '<' . $from_email_only . '>';
+				my $to = '"' . $u->user_id->name . '" <' . $to_email . '>';
+
+				my $m_obj = Email::Simple->new($msg) || croak "can't parse message";
+
+				$m_obj->header_set('Return-Path', $from_email_only) || croak "can't set Return-Path: header";
+				#$m_obj->header_set('Sender', $from_email_only) || croak "can't set Sender: header";
+				$m_obj->header_set('Errors-To', $from_email_only) || croak "can't set Errors-To: header";
+				$m_obj->header_set('From', $from_addr) || croak "can't set From: header";
+				$m_obj->header_set('To', $to) || croak "can't set To: header";
+
+				$m_obj->header_set('X-Nos-Version', $VERSION);
+				$m_obj->header_set('X-Nos-Hash', $hash);
+
+				# really send e-mail
+				my $sent_status;
+
+				if (@email_send_options) {
+					$sent_status = send $email_send_driver => $m_obj->as_string, @email_send_options;
+				} else {
+					$sent_status = send $email_send_driver => $m_obj->as_string;
+				}
+
+				croak "can't send e-mail: $sent_status\n\nOriginal e-mail follows:\n".$m_obj->as_string unless ($sent_status);
+				my @bad;
+				@bad = @{ $sent_status->prop('bad') } if (eval { $sent_status->can('prop') });
+				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;
 
-				my $hdr = "From: " . $u->list_id->name . " <" . $u->list_id->email . ">\n" .
-					"To: " . $u->user_id->full_name . " <". $u->user_id->email. ">\n";
+					print " - $sent_status\n";
 
-				# FIXME do real sending :-)
-				send IO => "$hdr\n$msg";
+					$ok++;
+				} else {
+					warn "ERROR: $sent_status\n";
+				}
 
-				$sent->create({
-					message_id => $m->message_id,
-					user_id => $u->user_id,
-				});
-				$sent->dbi_commit;
+				if ($sleep) {
+					warn "sleeping $sleep seconds\n";
+					sleep($sleep);
+				}
 			}
 		}
 		$m->all_sent(1);
@@ -189,20 +607,654 @@
 		$m->dbi_commit;
 	}
 
+	return $ok;
+
+}
+
+=head2 inbox_message
+
+Receive single message for list's inbox.
+
+ my $ok = $nos->inbox_message(
+ 	list => 'My list',
+	message => $message,
+ );
+
+This method is used by C<sender.pl> when receiving e-mail messages.
+
+=cut
+
+sub inbox_message {
+	my $self = shift;
+
+	my $arg = {@_};
+
+	return unless ($arg->{'message'});
+	croak "need list name" unless ($arg->{'list'});
+
+	$arg->{'list'} = lc($arg->{'list'});
+
+	my $this_list = $self->_get_list($arg->{'list'}) || croak "can't find list ".$arg->{'list'}."\n";
+
+	my $m = Email::Simple->new($arg->{'message'}) || croak "can't parse message";
+
+	my $to = $m->header('To') || die "can't find To: address in incomming message\n";
+
+	my $return_path = $m->header('Return-Path') || '';
+
+	my @addrs = Email::Address->parse( $to );
+
+	die "can't parse To: $to address\n" unless (@addrs);
+
+	my $hl = $self->{'hash_len'} || confess "no hash_len?";
+
+	my $hash;
+
+	foreach my $a (@addrs) {
+		if ($a->address =~ m/\+([a-f0-9]{$hl})@/i) {
+			$hash = $1;
+			last;
+		}
+	}
+
+	#warn "can't find hash in e-mail $to\n" unless ($hash);
+
+	my $sent = $self->{'loader'}->find_class('sent');
+
+	# will use null if no matching message_id is found
+	my $sent_msg;
+	$sent_msg = $sent->search( hash => $hash )->first if ($hash);
+
+	my ($message_id, $user_id) = (undef, undef);	# init with NULL
+
+	if ($sent_msg) {
+		$message_id = $sent_msg->message_id || carp "no message_id";
+		$user_id = $sent_msg->user_id || carp "no user_id";
+	} else {
+		#warn "can't find sender with hash $hash\n";
+		my $users = $self->{'loader'}->find_class('users');
+		my $from = $m->header('From');
+		$from = $1 if ($from =~ m/<(.*)>/);
+		my $this_user = $users->search( email => lc($from) )->first;
+		$user_id = $this_user->id if ($this_user);
+	}
+
+
+	my $is_bounce = 0;
+
+	if ($return_path eq '<>' || $return_path eq '') {
+		no warnings;
+		my $bounce = eval { Mail::DeliveryStatus::BounceParser->new(
+			$arg->{'message'}, { report_non_bounces=>1 },
+		) };
+		#warn "can't check if this message is bounce!" if ($@);
+	
+		$is_bounce++ if ($bounce && $bounce->is_bounce);
+	}
+
+	my $received = $self->{'loader'}->find_class('received');
+
+	my $this_received = $received->find_or_create({
+		user_id => $user_id,
+		list_id => $this_list->id,
+		message_id => $message_id,
+		message => $arg->{'message'},
+		bounced => $is_bounce,
+	}) || croak "can't insert received message";
+
+	$this_received->dbi_commit;
+
+#	print "message_id: ",($message_id || "not found")," -- $is_bounce\n";
 }
 
-=head2 EXPORT
+=head2 received_messages
+
+Returns all received messages for given list or user.
+
+ my @received = $nos->received_messages(
+ 	list => 'My list',
+	email => "john.doe@example.com",
+	from_date => '2005-01-01 10:15:00',
+	to_date => '2005-01-01 12:00:00',
+	message => 0,
+ );
+
+If don't specify C<list> or C<email> it will return all received messages.
+Results will be sorted by received date, oldest first.
+
+Other optional parametars include:
+
+=over 10
+
+=item from_date
+
+Date (in ISO format) for lower limit of dates received
+
+=item to_date
+
+Return just messages older than this date
+
+=item message
 
-None by default.
+Include whole received message in result. This will probably make result
+array very large. Use with care.
+
+=back
+
+Date ranges are inclusive, so results will include messages sent on
+particular date specified with C<date_from> or C<date_to>.
+
+Each element in returned array will have following structure:
+
+ my $row = {
+	id => 42,			# unique ID of received message
+	list => 'My list',		# useful if filtering by email
+	ext_id => 9999,			# ext_id from message sender
+	email => 'jdoe@example.com',	# e-mail of message sender
+	bounced => 0,			# true if message is bounce
+	date => '2005-08-24 18:57:24',	# date of receival in ISO format
+ }
+
+If you specified C<message> option, this hash will also have C<message> key
+which will contain whole received message.
+
+=cut
+
+sub received_messages {
+	my $self = shift;
+
+	my $arg = {@_} if (@_);
+
+#	croak "need list name or email" unless ($arg->{'list'} || $arg->{'email'});
+
+	my $sql = qq{
+			select
+				received.id as id,
+				lists.name as list,
+				users.ext_id as ext_id,
+				users.email as email,
+	};
+	$sql .= qq{		message,} if ($arg->{'message'});
+	$sql .= qq{
+				bounced,received.date as date
+			from received
+			join lists on lists.id = list_id
+			join users on users.id = user_id
+	};
+
+	my $order = qq{	order by date asc };
+
+	my $where;
+
+	$where->{'lists.name'} = lc($arg->{'list'}) if ($arg->{'list'});
+	$where->{'users.email'} = lc($arg->{'email'}) if ($arg->{'email'});
+	$where->{'received.date'} = { '>=', $arg->{'date_from'} } if ($arg->{'date_from'});
+	$where->{'received.date'} = { '<=', $arg->{'date_to'} } if ($arg->{'date_to'});
+
+	# hum, yammy one-liner
+	my($stmt, @bind)  = SQL::Abstract->new->where($where);
+
+	my $dbh = $self->{'loader'}->find_class('received')->db_Main;
+
+	my $sth = $dbh->prepare($sql . $stmt . $order);
+	$sth->execute(@bind);
+	return $sth->fetchall_hash;
+}
+
+
+=head1 INTERNAL METHODS
+
+Beware of dragons! You shouldn't need to call those methods directly.
+
+
+=head2 _add_aliases
+
+Add or update alias in C</etc/aliases> (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<archive> 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'"#;
+
+	# remove hostname from email to make Postfix's postalias happy
+	$email =~ s/@.+// if (not $self->{full_hostname_in_aliases});
+
+	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
+
+ my $list_obj = $nos->_add_list(
+ 	list => 'My list',
+	from => 'Outgoing from comment',
+	email => 'my-list@example.com',
+	aliases => '/etc/mail/mylist',
+ );
+
+Returns C<Class::DBI> object for created list.
+
+C<email> address can be with domain or without it if your
+MTA appends it. There is no checking for validity of your
+list e-mail. Flexibility comes with resposibility, so please
+feed correct (and configured) return addresses.
+
+=cut
+
+sub _add_list {
+	my $self = shift;
+
+	my $arg = {@_};
+
+	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,
+	});
+
+	croak "can't add list $name\n" unless ($l);
+
+	if ($from_addr && $l->from_addr ne $from_addr) {
+		$l->from_addr($from_addr);
+		$l->update;
+	}
+
+	$l->dbi_commit;
+
+	return $l;
+
+}
+
+
+
+=head2 _get_list
+
+Get list C<Class::DBI> object.
+
+ my $list_obj = $nos->check_list('My list');
+
+Returns false on failure.
+
+=cut
+
+sub _get_list {
+	my $self = shift;
+
+	my $name = shift || return;
+
+	my $lists = $self->{'loader'}->find_class('lists') || confess "can't find lists class";
+
+	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
+###
+
+package Nos::SOAP;
+
+use Carp;
+
+=head1 SOAP methods
+
+This methods are thin wrappers to provide SOAP calls. They are grouped in
+C<Nos::SOAP> package which is in same F<Nos.pm> module file.
+
+Usually, you want to use named variables in your SOAP calls if at all
+possible.
+
+However, if you have broken SOAP library (like PHP SOAP class from PEAR)
+you will want to use positional arguments (in same order as documented for
+methods below).
+
+=cut
+
+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',
+ );
+
+If you are writing SOAP server (like C<soap.cgi> example), you will need to
+call this method once to make new instance of Nos::SOAP and specify C<dsn>
+and options for it.
+
+=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";
+
+	$self ? return $self : return undef;
+}
+
+
+=head2 CreateList
+
+ $message_id = CreateList(
+	list => 'My list',
+	from => 'Name of my list',
+	email => 'my-list@example.com'
+ ); 
+
+=cut
+
+sub CreateList {
+	my $self = shift;
+
+	my $aliases = $nos->{'aliases'} || croak "need 'aliases' argument to new constructor";
+
+	if ($_[0] !~ m/^HASH/) {
+		return $nos->create_list(
+			list => $_[0], from => $_[1], email => $_[2],
+			aliases => $aliases,
+		);
+	} else {
+		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(
+	list => 'My list',
+	email => 'e-mail@example.com',
+	name => 'Full Name',
+	ext_id => 42,
+ );
+
+=cut
+
+sub AddMemberToList {
+	my $self = shift;
+
+	if ($_[0] !~ m/^HASH/) {
+		return $nos->add_member_to_list(
+			list => $_[0], email => $_[1], name => $_[2], ext_id => $_[3],
+		);
+	} else {
+		return $nos->add_member_to_list( %{ shift @_ } );
+	}
+}
+
+
+=head2 ListMembers
+
+ my @members = ListMembers(
+ 	list => 'My list',
+ );
+
+Returns array of hashes with user informations, see C<list_members>.
+
+=cut
+
+sub ListMembers {
+	my $self = shift;
+
+	my $list_name;
+
+	if ($_[0] !~ m/^HASH/) {
+		$list_name = shift;
+	} else {
+		$list_name = $_[0]->{'list'};
+	}
+
+	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(
+	list => 'My list',
+	message => 'From: My list...'
+ ); 
+
+=cut
+
+sub AddMessageToList {
+	my $self = shift;
+
+	if ($_[0] !~ m/^HASH/) {
+		return $nos->add_message_to_list(
+			list => $_[0], message => $_[1],
+		);
+	} else {
+		return $nos->add_message_to_list( %{ shift @_ } );
+	}
+}
+
+=head2 MessagesReceived
+
+Return statistics about received messages.
+
+ my @result = MessagesReceived(
+ 	list => 'My list',
+	email => 'jdoe@example.com',
+	from_date => '2005-01-01 10:15:00',
+	to_date => '2005-01-01 12:00:00',
+	message => 0,
+ );
+
+You must specify C<list> or C<email> or any combination of those two. Other
+parametars are optional.
+
+For format of returned array element see C<received_messages>.
+
+=cut
+
+sub MessagesReceived {
+	my $self = shift;
+
+	if ($_[0] !~ m/^HASH/) {
+		die "need at least list or email" unless (scalar @_ < 2);
+		return \@{ $nos->received_messages(
+			list => $_[0], email => $_[1],
+			from_date => $_[2], to_date => $_[3],
+			message => $_[4]
+		) };
+	} else {
+		my $arg = shift;
+		die "need list or email argument" unless ($arg->{'list'} || $arg->{'email'});
+		return \@{ $nos->received_messages( %{ $arg } ) };
+	}
+}
+
+###
+
+=head1 NOTE ON ARRAYS IN SOAP
+
+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.
+
+=head1 EXPORT
+
+Nothing.
 
 =head1 SEE ALSO
 
 mailman, ezmlm, sympa, L<Mail::Salsa>
 
+
 =head1 AUTHOR
 
 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
 
+
 =head1 COPYRIGHT AND LICENSE
 
 Copyright (C) 2005 by Dobrica Pavlinusic
@@ -213,3 +1265,5 @@
 
 
 =cut
+
+1;