From a0f3443436330aa8b2b018841d8dafda2c02c3fa Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 10:31:52 +0200 Subject: [PATCH 01/21] Refactoring postfix transport script to allow pluggable commands. --- lib/WebGUI/MailCommand.pm | 53 +++++++++++++++ lib/WebGUI/MailCommand/Bounce.pm | 40 ++++++++++++ lib/WebGUI/MailCommand/Subscribe.pm | 27 ++++++++ sbin/newsletter-transport.pl | 99 +++++++++++++++++++---------- 4 files changed, 184 insertions(+), 35 deletions(-) create mode 100644 lib/WebGUI/MailCommand.pm create mode 100644 lib/WebGUI/MailCommand/Bounce.pm create mode 100644 lib/WebGUI/MailCommand/Subscribe.pm diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm new file mode 100644 index 0000000..e81f90f --- /dev/null +++ b/lib/WebGUI/MailCommand.pm @@ -0,0 +1,53 @@ +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 $commandClass = resolveCommandClass( $command ) + || return; + + my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] ); + + return $commandObject->process( $parameter ); +} + +sub session { + return (shift)->{ _session }; +} + +sub resolveCommandClass { + my $command = shift; + + # TODO: Do not hard code. + my %commands = ( + 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..c4057db --- /dev/null +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -0,0 +1,27 @@ +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 $session = $self->session; + my $log = $session->log; + + my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName ); + + die "Invalid list name [$listName]" unless $asset; + + $asset->subscribeThroughEmail( $fromAddress ); + + return; +} + +1; + diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 044e54e..8ec705b 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -8,53 +8,82 @@ BEGIN { } use strict; +use warnings; -use Mail::DeliveryStatus::BounceParser; -use WebGUI::Mailing::Email; +#use Mail::DeliveryStatus::BounceParser; +#use WebGUI::Mailing::Email; +use WebGUI::MailCommand; use List::MoreUtils qw{ any }; +use WebGUI::Config; +use Getopt::Long; + +use 5.010; 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 ) = getCredentials(); -my $configFile = $configs{ $domain }; -my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm }; - -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 ); + if ( WebGUI::MailCommand::isValidCommand( $command ) ) { + my $session = openSession( $webguiRoot, $configFile ); - my $report = ( $dsr->reports )[0]; - my $reason = $report->get( 'std_reason' ); - my $message = $report->get( 'reason' ); - $message =~ s{\s+}{ }g; - - $session->log->warn( 'about to register as bounced' ); - $email->registerBounced( $reason, $message ); + WebGUI::MailCommand::processCommand( $session, $command, $id ); + + closeSession( $session ); } else { - $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" ); + # TODO: log something } + exit(0); +} + +#----------------------------------------------------------------------------- +sub getCredentials { + my ( $domain, $user ); + + GetOptions( + 'domain=s' => \$domain, + 'user=s' => \$user, + ); + die "--domain parameter is required" unless $domain; + die "--user paramere is required" unless $user; + + my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) + || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; + + my $configFile = $dispatch->get( $domain ) + || die "Received mail for domain [$domain] which is not configured!"; + + # Format is mailId-command + my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix; + + die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; + die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; + + return ( $configFile, $command, $id ); +} + +#----------------------------------------------------------------------------- +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 }; +} From 4cebd9c26f0dd4b065431381bfcdff73796fe6b5 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 10:33:33 +0200 Subject: [PATCH 02/21] Began refactoring Subscriber aspect to allow (un)subscription by email. --- lib/WebGUI/AssetAspect/Subscriber.pm | 32 ++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 272e14a..e143871 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -389,6 +389,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' ); @@ -472,6 +473,24 @@ 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 ( !defined $emailUser ) { + $emailUser = WebGUI::User::SpecialState->create( $session ); + $emailUser->update( { email => $email } ); + } + $emailUser->addSpecialState( 'Subscriber', $self->getId ); + + $self->subscribe( $emailUser, 1 ); + + return; +} + #---------------------------------------------------------------------------- sub www_processSubscription { my $self = shift; @@ -501,13 +520,14 @@ sub www_processSubscription { $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->subscribeAnonymous( $email ); + #if ( !defined $emailUser ) { + # $emailUser = WebGUI::User::SpecialState->create( $session ); + # $emailUser->update( { email => $email } ); + #} + #$emailUser->addSpecialState( 'Subscriber', $self->getId ); - $self->subscribe( $emailUser, 1 ); + #$self->subscribe( $emailUser, 1 ); } } else { From e3932e2ca40935cc8867a2fb6a73e64dbed55ccd Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 15:16:06 +0200 Subject: [PATCH 03/21] Finsished breaking out anonymous (un)subscribe functions. --- lib/WebGUI/AssetAspect/Subscriber.pm | 33 +++++++++++++++++----------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index e143871..9f50beb 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -2,6 +2,7 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; +use 5.010; use Class::C3; use Carp; @@ -473,6 +474,7 @@ sub www_confirmMutation { } +#---------------------------------------------------------------------------- sub subscribeAnonymous { my $self = shift; my $email = shift; # TODO || return ? @@ -480,6 +482,7 @@ sub subscribeAnonymous { 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 } ); @@ -491,6 +494,20 @@ sub subscribeAnonymous { 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; @@ -515,19 +532,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' ) { - $self->subscribeAnonymous( $email ); - #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 { From 2cd069d0be512bc2831128307dfbb03915753df2 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 16:29:29 +0200 Subject: [PATCH 04/21] Add listname property. --- lib/WebGUI/AssetAspect/Subscriber.pm | 44 ++++++++++++++++++++++++++++ sbin/install_newsletter.pl | 19 +++++++++++- 2 files changed, 62 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 9f50beb..1e5d32f 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -19,6 +19,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' ), @@ -264,6 +269,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; diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 5a75065..90b30c7 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,9 +32,26 @@ addTemplateColumnToNewsletterCollection( $session ); addRecentColumnToNewsletterCollection( $session ); renamespaceTemplates( $session ); addSpecialStateTable( $session ); +addListNameColumn( $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; From ae59627228b31712db20700ae9d671b71c984fb8 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:53:35 +0200 Subject: [PATCH 05/21] Add missing use clauses; --- lib/WebGUI/AssetAspect/Subscriber.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 1e5d32f..64dcd65 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -8,6 +8,12 @@ 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; From ec4834090ddfc962a85fe36304d5cc1cd9ecd502 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:55:27 +0200 Subject: [PATCH 06/21] Add (us)subscribe commands and pass sender address along. --- lib/WebGUI/MailCommand.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm index e81f90f..a37aca1 100644 --- a/lib/WebGUI/MailCommand.pm +++ b/lib/WebGUI/MailCommand.pm @@ -24,13 +24,14 @@ 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 ); + return $commandObject->process( $parameter, $sender ); } sub session { @@ -42,7 +43,9 @@ sub resolveCommandClass { # TODO: Do not hard code. my %commands = ( - bounce => 'WebGUI::MailCommand::Bounce', + unsubscribe => 'WebGUI::MailCommand::Unsubscribe', + subscribe => 'WebGUI::MailCommand::Subscribe', + bounce => 'WebGUI::MailCommand::Bounce', ); return $commands{ $command } if exists $commands{ $command }; From 781f05f4f091b3ac0bfc8127bf78c83b813e0220 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:57:02 +0200 Subject: [PATCH 07/21] Fixup Subscribe command prototype. --- lib/WebGUI/MailCommand/Subscribe.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/MailCommand/Subscribe.pm b/lib/WebGUI/MailCommand/Subscribe.pm index c4057db..2244b1b 100644 --- a/lib/WebGUI/MailCommand/Subscribe.pm +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -9,16 +9,17 @@ use base 'WebGUI::MailCommand'; #----------------------------------------------------------------------------- sub process { - my $self = shift; - my $listName= shift; - my $session = $self->session; - my $log = $session->log; + my $self = shift; + my $listName = shift; + my $fromAddress = shift; + my $session = $self->session; + my $log = $session->log; - my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName ); + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); die "Invalid list name [$listName]" unless $asset; - $asset->subscribeThroughEmail( $fromAddress ); + $asset->subscribeAnonymous( $fromAddress ); return; } From 66774431f24f9d8716ce998e4a625c1c37624bec Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:59:35 +0200 Subject: [PATCH 08/21] Set env ip to that of sender. --- sbin/newsletter-transport.pl | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 8ec705b..d26eaf8 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -25,17 +25,23 @@ my $webguiRoot = '/data/WebGUI'; #--------------------------------------------------------------- # Startup { - my ( $configFile, $command, $id ) = getCredentials(); + my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials(); if ( WebGUI::MailCommand::isValidCommand( $command ) ) { my $session = openSession( $webguiRoot, $configFile ); - - WebGUI::MailCommand::processCommand( $session, $command, $id ); - + no warnings 'once'; + *{ WebGUI::Session::Env::getIp } = sub { + return $senderIp; + }; + + $session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]"); + + WebGUI::MailCommand::processCommand( $session, $command, $id, $sender ); + closeSession( $session ); } else { - # TODO: log something + die "Not a valid command [$command]."; } exit(0); @@ -43,14 +49,18 @@ my $webguiRoot = '/data/WebGUI'; #----------------------------------------------------------------------------- sub getCredentials { - my ( $domain, $user ); + my ( $domain, $user, $sender, $senderIp ); GetOptions( 'domain=s' => \$domain, 'user=s' => \$user, + 'sender=s' => \$sender, + 'senderIp=s'=> \$senderIp, ); die "--domain parameter is required" unless $domain; - die "--user paramere is required" unless $user; + die "--user parameter is required" unless $user; + die "--sender parameter is required" unless $sender; + die "--senderIp parameter is required" unless $senderIp; my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; @@ -64,7 +74,8 @@ sub getCredentials { die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; - return ( $configFile, $command, $id ); + + return ( $configFile, $command, $id, $sender, $senderIp ); } #----------------------------------------------------------------------------- From d56e463a581f6b3fc78b4b713be2753782c473af Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 18:03:39 +0200 Subject: [PATCH 09/21] Adding Unsubscribe command. --- lib/WebGUI/MailCommand/Unsubscribe.pm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 lib/WebGUI/MailCommand/Unsubscribe.pm 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; + From 37120bafa884110e9459c19db02b0a652e1ff931 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 10:31:52 +0200 Subject: [PATCH 10/21] Refactoring postfix transport script to allow pluggable commands. --- lib/WebGUI/MailCommand.pm | 53 +++++++++++++++ lib/WebGUI/MailCommand/Bounce.pm | 40 ++++++++++++ lib/WebGUI/MailCommand/Subscribe.pm | 27 ++++++++ sbin/newsletter-transport.pl | 99 +++++++++++++++++++---------- 4 files changed, 184 insertions(+), 35 deletions(-) create mode 100644 lib/WebGUI/MailCommand.pm create mode 100644 lib/WebGUI/MailCommand/Bounce.pm create mode 100644 lib/WebGUI/MailCommand/Subscribe.pm diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm new file mode 100644 index 0000000..e81f90f --- /dev/null +++ b/lib/WebGUI/MailCommand.pm @@ -0,0 +1,53 @@ +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 $commandClass = resolveCommandClass( $command ) + || return; + + my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] ); + + return $commandObject->process( $parameter ); +} + +sub session { + return (shift)->{ _session }; +} + +sub resolveCommandClass { + my $command = shift; + + # TODO: Do not hard code. + my %commands = ( + 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..c4057db --- /dev/null +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -0,0 +1,27 @@ +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 $session = $self->session; + my $log = $session->log; + + my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName ); + + die "Invalid list name [$listName]" unless $asset; + + $asset->subscribeThroughEmail( $fromAddress ); + + return; +} + +1; + diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 044e54e..8ec705b 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -8,53 +8,82 @@ BEGIN { } use strict; +use warnings; -use Mail::DeliveryStatus::BounceParser; -use WebGUI::Mailing::Email; +#use Mail::DeliveryStatus::BounceParser; +#use WebGUI::Mailing::Email; +use WebGUI::MailCommand; use List::MoreUtils qw{ any }; +use WebGUI::Config; +use Getopt::Long; + +use 5.010; 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 ) = getCredentials(); -my $configFile = $configs{ $domain }; -my $validCommand = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm }; - -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 ); + if ( WebGUI::MailCommand::isValidCommand( $command ) ) { + my $session = openSession( $webguiRoot, $configFile ); - my $report = ( $dsr->reports )[0]; - my $reason = $report->get( 'std_reason' ); - my $message = $report->get( 'reason' ); - $message =~ s{\s+}{ }g; - - $session->log->warn( 'about to register as bounced' ); - $email->registerBounced( $reason, $message ); + WebGUI::MailCommand::processCommand( $session, $command, $id ); + + closeSession( $session ); } else { - $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" ); + # TODO: log something } + exit(0); +} + +#----------------------------------------------------------------------------- +sub getCredentials { + my ( $domain, $user ); + + GetOptions( + 'domain=s' => \$domain, + 'user=s' => \$user, + ); + die "--domain parameter is required" unless $domain; + die "--user paramere is required" unless $user; + + my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) + || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; + + my $configFile = $dispatch->get( $domain ) + || die "Received mail for domain [$domain] which is not configured!"; + + # Format is mailId-command + my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix; + + die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; + die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; + + return ( $configFile, $command, $id ); +} + +#----------------------------------------------------------------------------- +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 }; +} From 28e49e3dab88fc89cb3d29b65ed7382105e1fdc5 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 10:33:33 +0200 Subject: [PATCH 11/21] Began refactoring Subscriber aspect to allow (un)subscription by email. --- lib/WebGUI/AssetAspect/Subscriber.pm | 32 ++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 272e14a..e143871 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -389,6 +389,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' ); @@ -472,6 +473,24 @@ 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 ( !defined $emailUser ) { + $emailUser = WebGUI::User::SpecialState->create( $session ); + $emailUser->update( { email => $email } ); + } + $emailUser->addSpecialState( 'Subscriber', $self->getId ); + + $self->subscribe( $emailUser, 1 ); + + return; +} + #---------------------------------------------------------------------------- sub www_processSubscription { my $self = shift; @@ -501,13 +520,14 @@ sub www_processSubscription { $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->subscribeAnonymous( $email ); + #if ( !defined $emailUser ) { + # $emailUser = WebGUI::User::SpecialState->create( $session ); + # $emailUser->update( { email => $email } ); + #} + #$emailUser->addSpecialState( 'Subscriber', $self->getId ); - $self->subscribe( $emailUser, 1 ); + #$self->subscribe( $emailUser, 1 ); } } else { From 66209f41027342d70c5023390d67c46e8727fc83 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 15:16:06 +0200 Subject: [PATCH 12/21] Finsished breaking out anonymous (un)subscribe functions. --- lib/WebGUI/AssetAspect/Subscriber.pm | 33 +++++++++++++++++----------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index e143871..9f50beb 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -2,6 +2,7 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; +use 5.010; use Class::C3; use Carp; @@ -473,6 +474,7 @@ sub www_confirmMutation { } +#---------------------------------------------------------------------------- sub subscribeAnonymous { my $self = shift; my $email = shift; # TODO || return ? @@ -480,6 +482,7 @@ sub subscribeAnonymous { 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 } ); @@ -491,6 +494,20 @@ sub subscribeAnonymous { 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; @@ -515,19 +532,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' ) { - $self->subscribeAnonymous( $email ); - #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 { From 9422d7cd8487f1fbc8f7a63cf3495dec2a5c1006 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 16:29:29 +0200 Subject: [PATCH 13/21] Add listname property. --- lib/WebGUI/AssetAspect/Subscriber.pm | 44 ++++++++++++++++++++++++++++ sbin/install_newsletter.pl | 19 +++++++++++- 2 files changed, 62 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 9f50beb..1e5d32f 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -19,6 +19,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' ), @@ -264,6 +269,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; diff --git a/sbin/install_newsletter.pl b/sbin/install_newsletter.pl index 5a75065..90b30c7 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,9 +32,26 @@ addTemplateColumnToNewsletterCollection( $session ); addRecentColumnToNewsletterCollection( $session ); renamespaceTemplates( $session ); addSpecialStateTable( $session ); +addListNameColumn( $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; From 98ce48f82740fc4094f28b0977cc28e5fda8e923 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:53:35 +0200 Subject: [PATCH 14/21] Add missing use clauses; --- lib/WebGUI/AssetAspect/Subscriber.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 1e5d32f..64dcd65 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -8,6 +8,12 @@ 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; From 831f3ef17a980a1ea113b64dde450eb016ce390c Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:55:27 +0200 Subject: [PATCH 15/21] Add (us)subscribe commands and pass sender address along. --- lib/WebGUI/MailCommand.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/MailCommand.pm b/lib/WebGUI/MailCommand.pm index e81f90f..a37aca1 100644 --- a/lib/WebGUI/MailCommand.pm +++ b/lib/WebGUI/MailCommand.pm @@ -24,13 +24,14 @@ 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 ); + return $commandObject->process( $parameter, $sender ); } sub session { @@ -42,7 +43,9 @@ sub resolveCommandClass { # TODO: Do not hard code. my %commands = ( - bounce => 'WebGUI::MailCommand::Bounce', + unsubscribe => 'WebGUI::MailCommand::Unsubscribe', + subscribe => 'WebGUI::MailCommand::Subscribe', + bounce => 'WebGUI::MailCommand::Bounce', ); return $commands{ $command } if exists $commands{ $command }; From 72f1e99bb893910ecce001b4d2ea85e5d761de0f Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:57:02 +0200 Subject: [PATCH 16/21] Fixup Subscribe command prototype. --- lib/WebGUI/MailCommand/Subscribe.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/MailCommand/Subscribe.pm b/lib/WebGUI/MailCommand/Subscribe.pm index c4057db..2244b1b 100644 --- a/lib/WebGUI/MailCommand/Subscribe.pm +++ b/lib/WebGUI/MailCommand/Subscribe.pm @@ -9,16 +9,17 @@ use base 'WebGUI::MailCommand'; #----------------------------------------------------------------------------- sub process { - my $self = shift; - my $listName= shift; - my $session = $self->session; - my $log = $session->log; + my $self = shift; + my $listName = shift; + my $fromAddress = shift; + my $session = $self->session; + my $log = $session->log; - my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName ); + my $asset = WebGUI::AssetAspect::Subscriber->getAssetByListName( $session, $listName ); die "Invalid list name [$listName]" unless $asset; - $asset->subscribeThroughEmail( $fromAddress ); + $asset->subscribeAnonymous( $fromAddress ); return; } From 176becbfcee0578f6ac925aaa38c58a07b34a305 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 17:59:35 +0200 Subject: [PATCH 17/21] Set env ip to that of sender. --- sbin/newsletter-transport.pl | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index 8ec705b..d26eaf8 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -25,17 +25,23 @@ my $webguiRoot = '/data/WebGUI'; #--------------------------------------------------------------- # Startup { - my ( $configFile, $command, $id ) = getCredentials(); + my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials(); if ( WebGUI::MailCommand::isValidCommand( $command ) ) { my $session = openSession( $webguiRoot, $configFile ); - - WebGUI::MailCommand::processCommand( $session, $command, $id ); - + no warnings 'once'; + *{ WebGUI::Session::Env::getIp } = sub { + return $senderIp; + }; + + $session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]"); + + WebGUI::MailCommand::processCommand( $session, $command, $id, $sender ); + closeSession( $session ); } else { - # TODO: log something + die "Not a valid command [$command]."; } exit(0); @@ -43,14 +49,18 @@ my $webguiRoot = '/data/WebGUI'; #----------------------------------------------------------------------------- sub getCredentials { - my ( $domain, $user ); + my ( $domain, $user, $sender, $senderIp ); GetOptions( 'domain=s' => \$domain, 'user=s' => \$user, + 'sender=s' => \$sender, + 'senderIp=s'=> \$senderIp, ); die "--domain parameter is required" unless $domain; - die "--user paramere is required" unless $user; + die "--user parameter is required" unless $user; + die "--sender parameter is required" unless $sender; + die "--senderIp parameter is required" unless $senderIp; my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' ) || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; @@ -64,7 +74,8 @@ sub getCredentials { die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; - return ( $configFile, $command, $id ); + + return ( $configFile, $command, $id, $sender, $senderIp ); } #----------------------------------------------------------------------------- From 14a1a03ba6e998cc4284e6b5917272c259d9f2e1 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 13 Oct 2010 18:03:39 +0200 Subject: [PATCH 18/21] Adding Unsubscribe command. --- lib/WebGUI/MailCommand/Unsubscribe.pm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 lib/WebGUI/MailCommand/Unsubscribe.pm 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; + From de511529500363172ffef452ea8ad541413b67df Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Thu, 28 Oct 2010 15:10:09 +0200 Subject: [PATCH 19/21] Don't die on error but exit with correct code. --- sbin/newsletter-transport.pl | 31 ++++++++++++++++++------------- 1 file changed, 18 insertions(+), 13 deletions(-) diff --git a/sbin/newsletter-transport.pl b/sbin/newsletter-transport.pl index d26eaf8..8b59b0a 100755 --- a/sbin/newsletter-transport.pl +++ b/sbin/newsletter-transport.pl @@ -9,17 +9,20 @@ 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; -use 5.010; +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'; #--------------------------------------------------------------- @@ -41,7 +44,9 @@ my $webguiRoot = '/data/WebGUI'; closeSession( $session ); } else { - die "Not a valid command [$command]."; + warn "Not a valid command [$command]."; + exit( $NO_SUCH_USER ); + #die "Not a valid command [$command]."; } exit(0); @@ -57,22 +62,22 @@ sub getCredentials { 'sender=s' => \$sender, 'senderIp=s'=> \$senderIp, ); - die "--domain parameter is required" unless $domain; - die "--user parameter is required" unless $user; - die "--sender parameter is required" unless $sender; - die "--senderIp parameter is required" unless $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' ) - || die "Cannot open $webguiRoot/etc/mailing_dispatch.config"; + || warn "Cannot open $webguiRoot/etc/mailing_dispatch.config" && exit( $CONFIG_ERROR ); my $configFile = $dispatch->get( $domain ) - || die "Received mail for domain [$domain] which is not configured!"; + || warn "Received mail for domain [$domain] which is not configured!" && exit( $UNKNOWN_HOST ); # Format is mailId-command my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix; - die "Received mail addressed to [$user\@$domain] which contains no id" unless $id; - die "Received mail addressed to [$user\@$domain] which contains no command" unless $command; + 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 ); From f66cc5f73f1d8796646b3e1e036ef388609e0957 Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Fri, 5 Nov 2010 11:28:34 +0100 Subject: [PATCH 20/21] Rewrite mail commands documentation. --- docs/mail_commands_setup.pod | 101 +++++++++++++++++++++++++++++++++++ docs/postfix_configuration | 17 ------ 2 files changed, 101 insertions(+), 17 deletions(-) create mode 100644 docs/mail_commands_setup.pod delete mode 100644 docs/postfix_configuration 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. From 63b0a9edf14e715e7784a9eb8aae3c8d4d0d64eb Mon Sep 17 00:00:00 2001 From: Martin Kamerbeek Date: Wed, 10 Nov 2010 15:04:17 +0100 Subject: [PATCH 21/21] Add text/plain part to confirmation and notifiocation mails. --- lib/WebGUI/AssetAspect/Subscriber.pm | 62 ++++++++++++++++++---------- 1 file changed, 41 insertions(+), 21 deletions(-) diff --git a/lib/WebGUI/AssetAspect/Subscriber.pm b/lib/WebGUI/AssetAspect/Subscriber.pm index 64dcd65..204ffbd 100644 --- a/lib/WebGUI/AssetAspect/Subscriber.pm +++ b/lib/WebGUI/AssetAspect/Subscriber.pm @@ -3,7 +3,7 @@ package WebGUI::AssetAspect::Subscriber; use strict; use warnings; use 5.010; -use Class::C3; +use Class::C3; use Carp; use WebGUI::Asset::Template; @@ -45,7 +45,7 @@ sub definition { alwaysConfirmSubscription => { fieldType => 'yesNo', defaultValue => 0, - label => $i18n->get( 'require confirmation' ), + label => $i18n->get( 'require confirmation' ), tab => 'subscription', }, allowAnonymousSubscription => { @@ -128,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" ) . '>', @@ -192,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 ); @@ -231,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 ; @@ -243,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. @@ -331,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]" ); @@ -362,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]" ); @@ -383,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; @@ -390,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=?', [ @@ -414,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=?', [ @@ -440,7 +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' ); @@ -466,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 ) { @@ -499,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,