diff --git a/docs/mail_commands_setup.pod b/docs/mail_commands_setup.pod new file mode 100644 index 0000000..10e0e1f --- /dev/null +++ b/docs/mail_commands_setup.pod @@ -0,0 +1,101 @@ +=head1 Configuring WebGUI mail commands + +This document discusses the steps required to tie WebGUI mal command into +postfix. + +=head2 Setting up WebGUI + +The mappings between To adress in the incoming emails and WebGUI instances is +defined in /data/WebGUI/etc/mailing_dispatch.config. This is a JSON file +containing a hash with domain to instance config file mappings: + + { + "mailing.domain1.com" : "www_domain1_com.conf", + "newsletter.foo.com" : "www_foo_com.conf" + } + +Note that any domain can be tied to any config file: domains don't have to +match. The only requirement is that the server can receive mail on the given +domain. Eg. the following is a valid mapping + + { + "newsletter.bar.com" : "www_xyzzy_com.conf" + } + +It is also possible to map multiple domains to a single config file, eg. + + { + "mailing.example.com" : "example_com.conf", + "mailing.foobar.org" : "example_com.conf" + } + +However it is not allowed to map a single domain to multiple config files. If +you do the instance that is used, is not defined. Eg. the following is NOT +allowed. + + { + "mailing.example.com" : "example_com.conf", + "mailing.example.com" : "foobar_org.conf" + } + + +=head2 Setting up Postfix + +The newsletter-transport.pl script in the webgui_newsletter sbin directory +acts as a bridge between postfix and WebGUI. It is intended to be invoked +by postfix's pipe command. + +=head3 Configuring master.cf + +We need a queue that processes mail intended for WebGUI. To do so add the +following to /etc/postfix/master.cf: + + wgml unix - n n - - pipe + flags=FR user=webgui argv=/data/custom/webgui_newsletter/sbin/newsletter-transport.pl \ + --domain=${domain} --user=${user} --sender=${sender} --senderIp=${client_address} + +This creates a queue called wgml that pipes all mail in it through the +newsletter-transport.pl script. Make sure that the user parameter is set correctly and argv +contains the full path to the newsletter-transport.pl script. + + +=head3 Setup a transport map + +In order to determine which emails should go to the wgml queue, create a +mapping in /etc/postfix/wg_mailer_transport. There are more ways to do this. + +If you use a dedicated maildomain used solely for receiving WebGUI mail +commands add a line like the following for each mail domain in your +/date/WebGUI/etc/mailing_dispatch.config: + + /@mailing.foo.com$/ wgml: + /@newsletter.example.com$/ wgml: + +If you use a domain that is not solely dedicated to receiving WebGUI mail +commands, you can match on individual commands: + + /^[a-zA-Z0-9_-]+-bounce@/ wgml: + /^[a-zA-Z0-9_-]+-subscribe@/ wgml: + + +Afterwards complile the mapping into a postfix lookup table + + postmap /etc/postfix/wg_mailer_transport + +You have to do this everytime you change the mapping. + +=head3 Configuring main.cf + +Now we need to tell postfix to use the mapping, and how to use the wgml +queue. To do this add the following to /etc/postfix/main.cf: + + smtpd_reject_unlisted_recipient = no + transport_maps = regexp:/etc/postfix/wg_mailer_transport + wgml_destination_recipient_limit = 1 + +Make sure you add the domains in your mailing_dispatch.config to the +mydestination directlive in main.cf: + + mydestination = mailing.foo.com, newsletter.example.org, some.other.domain + +Finally restart postfix. diff --git a/docs/postfix_configuration b/docs/postfix_configuration deleted file mode 100644 index b6ee775..0000000 --- a/docs/postfix_configuration +++ /dev/null @@ -1,17 +0,0 @@ -Add to /etc/postfix/main.cf: - smtpd_reject_unlisted_recipient = no - transport_maps = regexp:/etc/postfix/wg_mailer_transport - wgml_destination_recipient_limit = 1 - -Add to /etc/postfix/master.cf: - wgml unix - n n - - pipe - flags=FR user=martin argv=/data/custom/webgui_newsletter/sbin/newsletter-transport.pl ${domain} ${user} - - -Create /etc/postfix/wg_mailer_transport: - /^[a-zA-Z0-9]+-bounce@/ wgml: - -And run: - postmap /etc/postfix/wg_mailer_transport - -Finally restart postfix. diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 272e14a..204ffbd 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -2,11 +2,18 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; -use Class::C3; +use 5.010; +use Class::C3; use Carp; use WebGUI::Asset::Template; use WebGUI::Macro; +use WebGUI::Mail::Send; +use WebGUI::Group; +use WebGUI::Asset; +use WebGUI::Form; +use WebGUI::User::SpecialState; +use WebGUI::International; use Tie::IxHash; use URI; @@ -18,6 +25,11 @@ sub definition { my $i18n = WebGUI::International->new( $session,'AssetAspect_Subscriber' ); tie my %properties, 'Tie::IxHash', ( + listName => { + fieldType => 'text', + label => $i18n->echo("List name"), + tab => 'subscription', + }, subscriptionGroupId => { fieldType => 'subscriptionGroup', label => $i18n->get( 'Subscription group' ), @@ -33,7 +45,7 @@ sub definition { alwaysConfirmSubscription => { fieldType => 'yesNo', defaultValue => 0, - label => $i18n->get( 'require confirmation' ), + label => $i18n->get( 'require confirmation' ), tab => 'subscription', }, allowAnonymousSubscription => { @@ -116,7 +128,7 @@ sub getListHeaders { my $site = $self->session->url->getSiteURL; my $headers = { - 'List-Unsubscribe' => + 'List-Unsubscribe' => '<' . $site . $self->getUrl( "func=processSubscription&action=unsubscribe&email=$email" ) . '>', 'List-Subscribe' => '<' . $site . $self->getUrl( "func=processSubscription&action=subscribe&email=$email" ) . '>', @@ -180,13 +192,13 @@ sub appendSubscriptionFormVars { my $i18n = WebGUI::International->new( $session, 'AssetAspect_Subscriber' ); # Setup form controls - my $formHeader = + my $formHeader = WebGUI::Form::formHeader( $session, { action => $self->getUrl } ) . WebGUI::Form::hidden( $session, { name => 'func', value => 'processSubscription' } ) ; - my $subscribeButton = + my $subscribeButton = sprintf '', $i18n->get('subscribe'); - my $unsubscribeButton = + my $unsubscribeButton = sprintf '', $i18n->get('unsubscribe'); my $emailBox = WebGUI::Form::email( $session, { name => 'email', value => '' } ); my $formFooter = WebGUI::Form::formFooter( $session ); @@ -219,8 +231,8 @@ sub appendSubscriptionFormVars { sub getSubscriptionGroup { my $self = shift; my $groupId = $self->get( "subscriptionGroupId" ); - my $group = $groupId - ? WebGUI::Group->new( $self->session, $groupId ) + my $group = $groupId + ? WebGUI::Group->new( $self->session, $groupId ) : $self->createSubscriptionGroup ; @@ -231,7 +243,7 @@ sub getSubscriptionGroup { sub getReturnUrl { my $self = shift; my $referer = $self->session->env->get('HTTP_REFERER'); - + return unless $referer; # Get path and strip leading and trailing slash if it exists. @@ -263,6 +275,45 @@ sub getEmailVars { return $var; } +#---------------------------------------------------------------------------- +sub getAssetByListName { + my $class = shift; + my $session = shift; + my $listName = shift || return; + my $db = $session->db; + + my $assetId = $db->quickScalar( 'select assetId from assetAspectSubscriber where listName=? limit 1', [ + $listName + ] ); + + return unless $assetId; + + my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + + return $asset; +} + +#---------------------------------------------------------------------------- +sub processPropertiesFromFormPost { + my $self = shift; + my $session = $self->session; + my $form = $session->form; + + my $listName = $form->get('listName'); + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); + + my $errors = $self->next::method; + + if ( $asset && $asset->getId ne $self->getId ) { + return [ + @{ $errors || [] }, + "List name $listName is already taken." + ]; + } + + return $errors; +} + #---------------------------------------------------------------------------- sub sendSubscriptionConfirmation { my $self = shift; @@ -280,14 +331,18 @@ sub sendSubscriptionConfirmation { $var->{ actionIsSubscribe } = $action eq 'subscribe'; my $mail = WebGUI::Mail::Send->create( $self->session, { - to => $user->get('email'), - subject => $self->get('confirmationEmailSubject'), + to => $user->get('email'), + subject => $self->get('confirmationEmailSubject'), + contentType => 'multipart/alternative', } ); my $templateId = $self->get('confirmationEmailTemplateId'); my $template = WebGUI::Asset::Template->new( $session, $templateId ); if ( $template ) { - $mail->addHtml( $template->process( $var ) ); + my $content = $template->process( $var ); + + $mail->addHtml( $content ); + $mail->addText( $self->transformToText( $content ) ); } else { $session->log->error( "Cannot instanciate confirmation email template with id [$templateId]" ); @@ -311,14 +366,18 @@ sub sendNoMutationEmail { $var->{ actionIsSubscribe } = $action eq 'subscribe'; my $mail = WebGUI::Mail::Send->create( $self->session, { - to => $user->get('email'), - subject => $self->get('noMutationEmailSubject'), + to => $user->get('email'), + subject => $self->get('noMutationEmailSubject'), + contentType => 'multipart/alternative', } ); my $templateId = $self->get('noMutationEmailTemplateId'); my $template = WebGUI::Asset::Template->new( $session, $templateId ); if ( $template ) { - $mail->addHtml( $template->process( $var ) ); + my $content = $template->process( $var ); + + $mail->addHtml( $content ); + $mail->addText( $self->transformToText( $content ) ); } else { $session->log->error( "Cannot instanciate no mutation email template with id [$templateId]" ); @@ -332,6 +391,18 @@ sub sendNoMutationEmail { return; } +sub transformToText { + my $self = shift; + my $html = shift; + + my $text = $html; + #HTML::Entities::decode($text); + $text =~ s/(.+?)<\/a>/$2 ($1)/g; + $text = WebGUI::HTML::html2text($text); + + return $text; +} + #---------------------------------------------------------------------------- sub logConfirmation { my $self = shift; @@ -339,7 +410,7 @@ sub logConfirmation { my $session = $self->session; my $db = $session->db; - $db->write( + $db->write( ' update assetAspectSubscriber_log set ' .' confirmationIp=?, confirmationDate=?, confirmed=? where code=? and assetId=?', [ @@ -363,7 +434,7 @@ sub logRequest { my $session = $self->session; my $db = $session->db; - $db->write( + $db->write( ' insert into assetAspectSubscriber_log set ' .' assetId=?, requestIp=?, requestDate=?, code=?, confirmed=?, anonymous=?, type=?, userId=?, email=?', [ @@ -389,6 +460,7 @@ sub subscribe { my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); my $session = $self->session; + if ( $requireConfirm ) { if ( $user->isInGroup( $self->getSubscriptionGroup->getId ) ) { $self->sendNoMutationEmail( $user, 'subscribe' ); @@ -414,7 +486,7 @@ sub unsubscribe { my $self = shift; my $user = shift || $self->session->user; my $requireConfirm = shift // $self->get('alwaysConfirmSubscription'); - + my $session = $self->session; if ( $requireConfirm ) { @@ -447,8 +519,8 @@ sub www_confirmMutation { my $code = $form->get('code'); return unless $code; - my ($userId, $type) = $db->quickArray( - 'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?', + my ($userId, $type) = $db->quickArray( + 'select userId, type from assetAspectSubscriber_log where confirmed=? and code=?', [ 0, $code, @@ -472,6 +544,40 @@ sub www_confirmMutation { } +#---------------------------------------------------------------------------- +sub subscribeAnonymous { + my $self = shift; + my $email = shift; # TODO || return ? + my $session = $self->session; + + my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); + + # If email address doesn't have an account, create one. + if ( !defined $emailUser ) { + $emailUser = WebGUI::User::SpecialState->create( $session ); + $emailUser->update( { email => $email } ); + } + $emailUser->addSpecialState( 'Subscriber', $self->getId ); + + $self->subscribe( $emailUser, 1 ); + + return; +} + +#---------------------------------------------------------------------------- +sub unsubscribeAnonymous { + my $self = shift; + my $email = shift; + my $session = $self->session; + + my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); + if ( defined $emailUser ) { + $self->unsubscribe( $emailUser, 1 ); + } + + return; +} + #---------------------------------------------------------------------------- sub www_processSubscription { my $self = shift; @@ -496,18 +602,9 @@ sub www_processSubscription { my $email = $form->email( 'email' ); return 'Error: no email address passed' unless $email; - my $emailUser = WebGUI::User::SpecialState->newByEmail( $session, $email ); - if ( $action eq 'unsubscribe' && defined $emailUser ) { - $self->unsubscribe( $emailUser, 1 ); - } - if ( $action eq 'subscribe' ) { - if ( !defined $emailUser ) { - $emailUser = WebGUI::User::SpecialState->create( $session ); - $emailUser->update( { email => $email } ); - } - $emailUser->addSpecialState( 'Subscriber', $self->getId ); - - $self->subscribe( $emailUser, 1 ); + given ( $action ) { + when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); } + when ( 'subscribe' ) { $self->subscribeAnonymous( $email ); } } } else { diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm new file mode 100644 index 0000000..a37aca1 --- /dev/null +++ b/lib/WebGUI/MailCommand.pm @@ -0,0 +1,56 @@ +package WebGUI::MailCommand; + +use strict; +use warnings; + +sub isValidCommand { + my $command = shift; + + return defined resolveCommandClass( $command ); +} + +sub new { + my $class = shift; + my $session = shift || die "Need a session"; + + bless { _session => $session }, $class; +} + +sub process { + WebGUI::Error::OverrideMe->throw; +} + +sub processCommand { + my $session = shift; + my $command = shift; + my $parameter = shift; + my $sender = shift; + + my $commandClass = resolveCommandClass( $command ) + || return; + + my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] ); + + return $commandObject->process( $parameter, $sender ); +} + +sub session { + return (shift)->{ _session }; +} + +sub resolveCommandClass { + my $command = shift; + + # TODO: Do not hard code. + my %commands = ( + unsubscribe => 'WebGUI::MailCommand::Unsubscribe', + subscribe => 'WebGUI::MailCommand::Subscribe', + bounce => 'WebGUI::MailCommand::Bounce', + ); + + return $commands{ $command } if exists $commands{ $command }; + return; +} + +1; + diff --git a/lib/WebGUI/MailCommand/Bounce.pm b/lib/WebGUI/MailCommand/Bounce.pm new file mode 100644 index 0000000..752195b --- /dev/null +++ b/lib/WebGUI/MailCommand/Bounce.pm @@ -0,0 +1,40 @@ +package WebGUI::MailCommand::Bounce; + +use strict; +use warnings; + +use WebGUI::Mailing::Email; +use Mail::DeliveryStatus::BounceParser; + +use base 'WebGUI::MailCommand'; + +#----------------------------------------------------------------------------- +sub process { + my $self = shift; + my $hexId = shift; + my $session = $self->session; + my $log = $session->log; + my $id = $session->id->fromHex( $hexId ); + + my $email = WebGUI::Mailing::Email->new( $session, $id ); + + if ($email) { + my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN ); + + my $report = ( $dsr->reports )[0]; + my $reason = $report->get( 'std_reason' ); + my $message = $report->get( 'reason' ); + $message =~ s{\s+}{ }g; + + $log->warn( "Registering email [$id] as bounced." ); + $email->registerBounced( $reason, $message ); + } + else { + $log->error( "Cannot process bounced email [$id] because it cannot be located in the db." ); + } + + return; +} + +1; + diff --git a/lib/WebGUI/MailCommand/Subscribe.pm b/lib/WebGUI/MailCommand/Subscribe.pm new file mode 100644 index 0000000..2244b1b --- /dev/null +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -0,0 +1,28 @@ +package WebGUI::MailCommand::Subscribe; + +use strict; +use warnings; + +use WebGUI::AssetAspect::Subscriber; + +use base 'WebGUI::MailCommand'; + +#----------------------------------------------------------------------------- +sub process { + my $self = shift; + my $listName = shift; + my $fromAddress = shift; + my $session = $self->session; + my $log = $session->log; + + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); + + die "Invalid list name [$listName]" unless $asset; + + $asset->subscribeAnonymous( $fromAddress ); + + return; +} + +1; + diff --git a/lib/WebGUI/MailCommand/Unsubscribe.pm b/lib/WebGUI/MailCommand/Unsubscribe.pm new file mode 100644 index 0000000..e7ca1ca --- /dev/null +++ b/lib/WebGUI/MailCommand/Unsubscribe.pm @@ -0,0 +1,27 @@ +package WebGUI::MailCommand::Unsubscribe; + +use strict; +use warnings; + +use WebGUI::AssetAspect::Subscriber; + +use base 'WebGUI::MailCommand'; + +#----------------------------------------------------------------------------- +sub process { + my $self = shift; + my $listName = shift; + my $fromAddress = shift; + my $session = $self->session; + + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); + + die "Invalid list name [$listName]" unless $asset; + + $asset->unsubscribeAnonymous( $fromAddress ); + + return; +} + +1; + diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 89aa378..2d07aea 100644 --- a/sbin/install_newsletter.pl +++ b/sbin/install_newsletter.pl @@ -12,7 +12,7 @@ use strict; use Pod::Usage; use Getopt::Long; use WebGUI::Session; -use List::MoreUtils qw{ insert_after_string }; +use List::MoreUtils qw{ insert_after_string none }; # Get parameters here, including $help GetOptions( @@ -32,10 +32,27 @@ addTemplateColumnToNewsletterCollection( $session ); addRecentColumnToNewsletterCollection( $session ); renamespaceTemplates( $session ); addSpecialStateTable( $session ); +addListNameColumn( $session ); addRegistrationSteps( $session ); finish($session); + +#---------------------------------------------------------------------------- +sub addListNameColumn { + my $session = shift; + my $db = $session->db; + print "\tAdding list name column for subscribers..."; + + my @columns = $db->buildArray( 'desc assetAspectSubscriber' ); + + if ( none { $_ eq 'listName' } @columns ) { + $db->write( 'alter table assetAspectSubscriber add column listName varchar(255)' ); + } + + print "Done.\n"; +} + #---------------------------------------------------------------------------- sub installMailableAspectTable { my $session = shift; diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 044e54e..beedd33 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -8,53 +8,97 @@ BEGIN { } use strict; +use warnings; +use 5.010; -use Mail::DeliveryStatus::BounceParser; -use WebGUI::Mailing::Email; +use WebGUI::MailCommand; use List::MoreUtils qw{ any }; +use WebGUI::Config; +use Getopt::Long; +use Readonly; + +Readonly my $WRONG_USAGE => 64; +Readonly my $DATA_ERROR => 65; +Readonly my $NO_SUCH_USER => 67; +Readonly my $UNKNOWN_HOST => 68; +Readonly my $CONFIG_ERROR => 78; -my $NO_SUCH_USER = 67; my $webguiRoot = '/data/WebGUI'; -my %configs = ( - 'lom.lom.st.unitedknowledge.org' => 'www.lomcongres.nl.conf', -); - #--------------------------------------------------------------- -my ( $domain, $user ) = @ARGV; -my ( $mailId, $command ) = $user =~ m{^(.+)-([^-]+)$}i; +# Startup +{ + my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials(); -my $configFile = $configs{ $domain }; -my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm }; + if ( WebGUI::MailCommand::isValidCommand( $command ) ) { + my $session = openSession( $webguiRoot, $configFile ); + no warnings 'once'; + *{ WebGUI::Session::Env::getIp } = sub { + return $senderIp; + }; -unless ( $configFile && $validCommand ) { -# system "/usr/sbin/sendmail -G -i $user\@$domain"; - exit(0); -} -else { - my $session = WebGUI::Session->open($webguiRoot,$configFile); - $session->log->warn( 'valid bounce address' ); - my $email = WebGUI::Mailing::Email->new( $session, $session->id->fromHex( $mailId ) ); - - if ($email) { - $session->log->warn( 'found email' ); - my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN ); - - my $report = ( $dsr->reports )[0]; - my $reason = $report->get( 'std_reason' ); - my $message = $report->get( 'reason' ); - $message =~ s{\s+}{ }g; + $session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]"); - $session->log->warn( 'about to register as bounced' ); - $email->registerBounced( $reason, $message ); + WebGUI::MailCommand::processCommand( $session, $command, $id, $sender ); + + closeSession( $session ); } else { - $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" ); + warn "Not a valid command [$command]."; + exit( $NO_SUCH_USER ); + #die "Not a valid command [$command]."; } + exit(0); +} + +#----------------------------------------------------------------------------- +sub getCredentials { + my ( $domain, $user, $sender, $senderIp ); + + GetOptions( + 'domain=s' => \$domain, + 'user=s' => \$user, + 'sender=s' => \$sender, + 'senderIp=s'=> \$senderIp, + ); + warn "--domain parameter is required" && exit( $WRONG_USAGE ) unless $domain; + warn "--user parameter is required" && exit( $WRONG_USAGE ) unless $user; + warn "--sender parameter is required" && exit( $WRONG_USAGE ) unless $sender; + warn "--senderIp parameter is required" && exit( $WRONG_USAGE ) unless $senderIp; + + my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) + || warn "Cannot open $webguiRoot/etc/mailing_dispatch.config" && exit( $CONFIG_ERROR ); + + my $configFile = $dispatch->get( $domain ) + || warn "Received mail for domain [$domain] which is not configured!" && exit( $UNKNOWN_HOST ); + + # Format is mailId-command + my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix; + + print "Received mail addressed to [$user\@$domain] which contains no id" && exit( $NO_SUCH_USER ) unless $id; + print "Received mail addressed to [$user\@$domain] which contains no command" && exit( $NO_SUCH_USER ) unless $command; + + return ( $configFile, $command, $id, $sender, $senderIp ); +} + +#----------------------------------------------------------------------------- +sub openSession { + my $webguiRoot = shift; + my $configFile = shift; + + # Require WebGUI:Session rather than use it to save compilation of it when invalid commands are passed. + require WebGUI::Session; + + my $session = WebGUI::Session->open( $webguiRoot, $configFile ); + + return $session; +} + +#----------------------------------------------------------------------------- +sub closeSession { + my $session = shift; + $session->close; - exit (0); -} - -exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm }; +}