Merge branch 'mailcommand'

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.

docs/postfix_configuration

@@ -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.

lib/WebGUI/AssetAspect/Subscriber.pm

@@ -2,11 +2,18 @@ package WebGUI::AssetAspect::Subscriber;
 
 use strict;
 use warnings;
+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' ),
@@ -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;
@@ -282,12 +333,16 @@ sub sendSubscriptionConfirmation {
     my $mail = WebGUI::Mail::Send->create( $self->session, {
         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]" );
@@ -313,12 +368,16 @@ sub sendNoMutationEmail {
     my $mail = WebGUI::Mail::Send->create( $self->session, {
         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.*?href=["'](.*?)['"].*?>(.+?)<\/a>/$2 ($1)/g;
+    $text = WebGUI::HTML::html2text($text);
+
+    return $text;
+}
+
 #----------------------------------------------------------------------------
 sub logConfirmation {
     my $self    = shift;
@@ -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' );
@@ -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 {

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;
+

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;
+

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;
+

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;
+

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;

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 ) );
+        $session->log->warn( "IP is : [$senderIp][" .$session->env->getIp ."]");
 
-    if ($email) {
-        $session->log->warn( 'found email' );
-        my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN );
+        WebGUI::MailCommand::processCommand( $session, $command, $id, $sender );
 
-        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 );
+        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].";
     }
 
-    $session->close;
-    exit (0);
+    exit(0);
 }
 
-exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm };
+#-----------------------------------------------------------------------------
+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;
+}