moved honeypot check to www_processSubscription

<tmpl_var subscriptionForm_form>
<tmpl_var form_honeypot>
<tmpl_var form_honeypot_id>

It's used by default now.

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.

docs/required_modules

@@ -1,3 +1,3 @@
-Mail::DeliveryStatus::BounceParser
+Mail::DeliveryStatus::BounceParser (v 1.525)
-Class::InsideOut
+Class::InsideOut (v 1.10)
 

lib/WebGUI/Asset/Wobject/NewsletterCollection.pm

@@ -34,6 +34,13 @@ sub definition {
             tab             => 'display',
             defaultValue    => 1,
         },
+        useHoneypot => {
+            fieldType       => 'yesNo',
+            label           => $i18n->get('useHoneypot label'),
+            hoverHelp       => $i18n->get('useHoneypot description'),
+            tab             => 'security',
+            defaultValue    => 1,
+        },
     );
 
     push @{ $definition }, {
@@ -52,12 +59,16 @@ sub definition {
 sub getIssues {
     my $self    = shift;
 
-    my $issues  = $self->getLineage( [ 'children' ], {
+    # Caching of instanciated assets is not for speed, but is requied since prepareView is called on them, and we
-        returnObjects   => 1,
+    # need them again in that state in getViewVars.
-        orderByClause   => 'lineage desc',
+    unless ( $self->{ _issues } ) {
-    } );
+        $self->{ _issues } = $self->getLineage( [ 'children' ], {
+            returnObjects   => 1,
+            orderByClause   => 'lineage desc',
+        } );
+    }
 
-    return $issues;
+    return $self->{ _issues };
 }
 
 #----------------------------------------------------------------------------
@@ -88,7 +99,8 @@ sub getAssetContent {
     my $self    = shift;
     my $asset   = shift;
 
-    $asset->prepareView;
+    # Do not call prepareView on $asset here but rather do this in our own prepareView to prevent head tags being
+    # written to body.
     my $content = $asset->view;
 
     return $content;
@@ -106,6 +118,11 @@ sub prepareView {
 
     $self->{ _viewTemplate } = $template;
 
+    # Call prepareview on issues here, to prevent head tags ending up in the body.
+    foreach my $issue ( @{ $self->getIssues } ) {
+        $issue->prepareView;
+    }
+
     return;
 }
 
@@ -127,10 +144,10 @@ sub getViewVars {
         my $issueVar = $issue->get;
         $issueVar->{ url } = $issue->getUrl;
 
-        my $isRecent =
+        my $isRecent = defined $displayIssueId
-               ( !$displayIssueId && $recentCount < $maxRecent  )
+                     ? $issue->getId eq $displayIssueId
-            || ( $issue->getId eq $displayIssueId               )
+                     : $recentCount < $maxRecent
-            ;
+                     ;
 
         if ( $isRecent ) {
             $issueVar->{ content    } = $self->getAssetContent( $issue );
@@ -165,4 +182,3 @@ sub view {
 }
 
 1;
-

lib/WebGUI/AssetAspect/Mailable.pm

@@ -120,6 +120,8 @@ sub processContentAsUser {
         || $self->get('mailStyleTemplateId')
         || $self->get('styleTemplateId');
 
+    $session->stow->set( 'mailing_rendering' => 1 );
+
     # Generate email body for this user
     my $content = $session->style->process(
         $self->generateEmailContent( $issueId, $configuration ),
@@ -129,10 +131,13 @@ sub processContentAsUser {
     # Process macros
     WebGUI::Macro::process( $session, \$content );
 
+    $session->stow->delete( 'mailing_rendering' );
+
     # Become ourselves again.
     $session->user( { userId => $currentUser->getId } );
     $var->switchAdminOn if $adminOn;
 
+
     return $content;
 }
 

lib/WebGUI/AssetAspect/Subscriber.pm

@@ -2,11 +2,19 @@ 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::Form::Honeypot;
+use WebGUI::User::SpecialState;
+use WebGUI::International;
 use Tie::IxHash;
 use URI;
 
@@ -18,6 +26,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' ),
@@ -75,6 +88,13 @@ sub definition {
             namespace       => 'Subscriber/NoMutationEmail',
             tab             => 'subscription',
         },
+        confirmMutationTemplateId   => {
+            fieldType       => 'template',
+            defaultValue    => 'WUk-wEhGiF8dcEogrJfrfg',
+            label           => $i18n->get( 'confirm mutation template' ),
+            namespace       => 'Subscriber/MutationConfirmation',
+            tab             => 'subscription',
+        }
 	);
 
 	push( @{ $definition }, {
@@ -173,6 +193,44 @@ sub isSubscribed {
 }
 
 #----------------------------------------------------------------------------
+=head2 appendSubscriptionFormVars
+
+=head3 honeyPot
+Part of the form vars are the honeyPot variables. This is a form plugin that
+is used in NewsletterCollection.pm to activate the use of a honeypot or not,
+in this module, AssetAspect/Subscriber.pm, to check the honeypot and to
+display the form values and in i18n.
+
+There are the following form vars:
+
+=head4 subscriptionForm_emailBox
+This renders both the emailbox, subscribe/unsubscribe radio buttons and the
+honeypot form inputs:
+    <input id="email_formId" name="email" value="" size="30" maxlength="255" type="text">
+    <fieldset style="border:none;margin:0;padding:0">
+        <label>
+            <input name="action" value="subscribe" id="action1" type="radio">Inschrijven
+        </label>
+        <label>
+            <input name="action" value="unsubscribe" id="action2" type="radio">Uitschrijven
+        </label>
+    </fieldset>
+    <input name="hp_timestamp" value="1540249684" type="hidden">
+    <input id="d28a72b5e1a47804be42367afaf56b4d_hp" class="honeypot" name="hp_surname" value="" size="30" maxlength="255" type="text">
+
+You can easily make the honeypot input field invisible with some css for
+class honeypot.
+
+=head4 form_honeypot
+Renders these fields:
+    <input name="hp_timestamp" value="1540249684" type="hidden">
+    <input id="d28a72b5e1a47804be42367afaf56b4d_hp" class="honeypot" name="hp_surname" value="" size="30" maxlength="255" type="text">
+
+=head4 form_honeypot_id
+Gives you the id for the honeypot input. This makes it easy to create a label:
+
+
+=cut
 sub appendSubscriptionFormVars {
     my $self    = shift;
     my $var     = shift || {};
@@ -184,12 +242,37 @@ sub appendSubscriptionFormVars {
         WebGUI::Form::formHeader( $session, { action => $self->getUrl } )
         . WebGUI::Form::hidden( $session, { name => 'func', value => 'processSubscription' } )
         ;
-    my $subscribeButton = 
-        sprintf '<button type="submit" name="action" value="subscribe">%s</button>', $i18n->get('subscribe');
-    my $unsubscribeButton = 
-        sprintf '<button type="submit" name="action" value="unsubscribe">%s</button>', $i18n->get('unsubscribe');
-    my $emailBox = WebGUI::Form::email( $session, { name => 'email', value => '' } );
     my $formFooter = WebGUI::Form::formFooter( $session );
+    my $subscribeButton =
+        $formHeader
+        . WebGUI::Form::hidden( $session, { name => 'action', value => 'subscribe' } )
+        . WebGUI::Form::submit( $session, { value => $i18n->get('subscribe') } )
+        . $formFooter
+        ;
+    my $unsubscribeButton =
+        $formHeader
+        . WebGUI::Form::hidden( $session, { name => 'action', value => 'unsubscribe' } )
+        . WebGUI::Form::submit( $session, { value => $i18n->get('unsubscribe') } )
+        . $formFooter
+        ;
+    # honeypot is connected to the emailbox, that is displayed on anonymous subscription
+    # and only if set to useHoneyPot in definition/display
+    my $honeypot = WebGUI::Form::Honeypot->new( $self->session, { name => 'hp' } );
+    my $honeypot_form = $self->get('useHoneypot') ? $honeypot->toHtml : '';
+    my $emailBox =
+        $formHeader
+        . WebGUI::Form::email( $session, { name => 'email', value => '' } )
+        . WebGUI::Form::radioList( $session, {
+            name    => 'action',
+            options => {
+                subscribe   => $i18n->get('subscribe'),
+                unsubscribe => $i18n->get('unsubscribe'),
+            }
+        } )
+        . $honeypot_form
+        . WebGUI::Form::submit( $session )
+        . $formFooter
+        ;
 
     # Compose default subscription form for current user
     my $form = '';
@@ -198,19 +281,21 @@ sub appendSubscriptionFormVars {
         $form .= $unsubscribeButton   if $self->canUnsubscribe;
     }
     elsif ( $self->get('allowAnonymousSubscription') ) {
-        $form = $emailBox . $subscribeButton . $unsubscribeButton;
+        $form = $emailBox;
     }
 
     # Setup tmpl_vars
-    $var->{ subscriptionForm_form               } = "$formHeader $form $formFooter" if $form;
+    $var->{ subscriptionForm_form               } = $form if $form;
     $var->{ subscriptionForm_header             } = $formHeader;
     $var->{ subscriptionForm_footer             } = $formFooter;
     $var->{ subscriptionForm_subscribeButton    } = $subscribeButton;
     $var->{ subscriptionForm_unsubscribeButton  } = $unsubscribeButton;
-    $var->{ subscrittionForm_emailBox           } = $emailBox;
+    $var->{ subscriptionForm_emailBox           } = $emailBox;
     $var->{ user_canSubscribe                   } = $self->canSubscribe;
     $var->{ user_canUnsubscribe                 } = $self->canUnsubscribe;
     $var->{ user_isRegistered                   } = $session->user->isRegistered;
+    $var->{ form_honeypot                       } = $honeypot->toHtml;
+    $var->{ form_honeypot_id                    } = $honeypot->get('id');
 
     return $var;
 }
@@ -263,6 +348,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;
@@ -271,7 +395,13 @@ sub sendSubscriptionConfirmation {
     my $action  = shift || 'subscribe';
     my $session = $self->session;
     my $i18n    = WebGUI::International->new( $session, 'AssetAspect_Subscriber' );
-
+=pod
+    my $honeypot = $session->form->honeypot( 'hp' );
+    if ( $self->get('useHoneypot') && $honeypot ) {
+        $session->log->warn( "Honeypot triggered: $honeypot" );
+        return;
+    }
+=cut
     my $var     = $self->getEmailVars( $user );
     my $url     = $session->url->getSiteURL . $self->getUrl( "func=confirmMutation;code=$code" );
 
@@ -280,14 +410,18 @@ sub sendSubscriptionConfirmation {
     $var->{ actionIsSubscribe   } = $action eq 'subscribe';
 
     my $mail = WebGUI::Mail::Send->create( $self->session, {
-        to      => $user->get('email'),
+        to          => $user->get('email'),
-        subject => $self->get('confirmationEmailSubject'),
+        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]" );
@@ -306,19 +440,29 @@ sub sendNoMutationEmail {
     my $action  = shift || 'subscribe';
     my $session = $self->session;
     my $i18n    = WebGUI::International->new( $session, 'AssetAspect_Subscriber' );
-
+=pod
+    my $honeypot = $session->form->honeypot( 'hp' );
+    if ( $self->get('useHoneypot') && $honeypot ) {
+        $session->log->warn( "Honeypot triggered: $honeypot" );
+        return;
+    }
+=cut
     my $var     = $self->getEmailVars( $user );
     $var->{ actionIsSubscribe   } = $action eq 'subscribe';
 
     my $mail = WebGUI::Mail::Send->create( $self->session, {
-        to      => $user->get('email'),
+        to          => $user->get('email'),
-        subject => $self->get('noMutationEmailSubject'),
+        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 +476,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 +545,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' );
@@ -455,21 +612,64 @@ sub www_confirmMutation {
         ]
     );
 
+    my $var = {
+        message     => $i18n->get( 'wrong code' ),
+        returnUrl   => $self->getUrl,
+        isSuccess   => 0,
+        "is$type"   => 1,
+    };
     if ( $userId ) {
         $self->logConfirmation( $code );
 
         if ( $type eq 'subscribe' ) {
             $self->getSubscriptionGroup->addUsers( [ $userId ] );
-            return $self->processStyle( sprintf $i18n->get( 'subscription successful'), $self->getUrl );
+
+            $var->{ message     } = sprintf $i18n->get( 'subscription successful'), $self->getUrl;
+            $var->{ isSuccess   } = 1;
         }
         elsif ( $type eq 'unsubscribe' ) {
             $self->getSubscriptionGroup->deleteUsers( [ $userId ] );
-            return $self->processStyle( sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl );
+
+            $var->{ message     } = sprintf $i18n->get( 'unsubscription successful' ), $self->getUrl;
+            $var->{ isSuccess   } = 1;
         }
     }
 
-    return $self->processStyle( $i18n->get( 'wrong code' ) );
+    return $self->processStyle( $self->processTemplate( $var, $self->get('confirmMutationTemplateId') ) );
+}
 
+#----------------------------------------------------------------------------
+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;
 }
 
 #----------------------------------------------------------------------------
@@ -482,6 +682,12 @@ sub www_processSubscription {
     my $action  = $form->get( 'action' );
     return unless $action eq 'subscribe' || $action eq 'unsubscribe';
 
+    my $honeypot = $session->form->honeypot( 'hp' );
+    if ( $self->get('useHoneypot') && $honeypot ) {
+        $session->log->warn( "Honeypot triggered: $honeypot" );
+        return;
+    }
+
     if ( $session->user->isRegistered ) {
         if ( $action eq 'subscribe' && $self->canSubscribe ) {
             $self->subscribe;
@@ -496,18 +702,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 );
+        given ( $action ) {
-        if ( $action eq 'unsubscribe' && defined $emailUser ) {
+            when ( 'unsubscribe' ) { $self->unsubscribeAnonymous( $email ); }
-            $self->unsubscribe( $emailUser, 1 );
+            when ( 'subscribe'   ) { $self->subscribeAnonymous( $email );   }
-        }
-        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 );
         }
     }
     else {
@@ -545,4 +742,3 @@ sub www_unsubscribe {
 }
 
 1;
-

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

lib/WebGUI/Mailing.pm

@@ -415,13 +415,13 @@ sub www_delete {
 
 #----------------------------------------------------------------------------
 sub www_edit {
-    my $self    = shift;
+    my $self        = shift;
-    my $session = $self->session;
+    my $session     = $self->session;
-    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
+    my $i18n        = WebGUI::International->new( $session, 'MailingManager' );
 
     return $session->privilege->insufficient unless $self->admin->canManage;
 
-    my $f = WebGUI::HTMLForm->new( $session );
+    my $f = $self->getEditForm;
     $f->hidden(
         name    => 'newsletter',
         value   => 'mailing',
@@ -435,6 +435,16 @@ sub www_edit {
         value   => $self->getId,
     );
 
+    return $self->renderInConsole( $f->print, $i18n->get('configure mailing') );
+}
+
+#----------------------------------------------------------------------------
+sub getEditForm {
+    my $self    = shift;
+    my $session = $self->session;
+    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
+    my $f       = WebGUI::HTMLForm->new( $session );
+
     my %fields          = %{ $self->getAsset->getMailingProperties( $self ) };
     my $configuration   = $self->get('configuration') || {};
     while ( my( $name, $properties ) = each %fields ) {
@@ -463,7 +473,7 @@ sub www_edit {
         extras  => qq{onclick="window.location='$cancelUrl'" class="backwardButton"},
     );
 
-    return $self->renderInConsole( $f->print, $i18n->get('configure mailing') );
+    return $f;
 }
 
 #----------------------------------------------------------------------------

lib/WebGUI/Mailing/Admin.pm

@@ -96,6 +96,7 @@ sub www_createMailing {
     my $self    = shift;
     my $session = $self->session;
     my $form    = $session->form;
+    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
 
     return $session->privilege->insufficient unless $self->canManage;
 
@@ -123,7 +124,64 @@ sub www_createMailing {
         state   => 'idle',
     } );
 
-    return $mailing->www_edit;
+    my $f = $mailing->getEditForm;
+    $f->hidden(
+        name    => 'newsletter',
+        value   => 'manage',
+    );
+    $f->hidden(
+        name    => 'func',
+        value   => 'createMailingSave',
+    );
+    $f->hidden(
+        name    => 'assetId',
+        value   => $assetId,
+    );
+    $f->hidden(
+        name    => 'issueId',
+        value   => $issueId,
+    );
+
+    my $output = $mailing->renderInConsole( $f->print, $i18n->get('configure mailing') );
+    $mailing->delete;
+
+    return $output;
+}
+
+#----------------------------------------------------------------------------
+sub www_createMailingSave {
+    my $self    = shift;
+    my $session = $self->session;
+    my $form    = $session->form;
+    my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
+
+    return $session->privilege->insufficient unless $self->canManage;
+
+    my $assetId = $form->guid( 'assetId' );
+    my $issueId = $form->guid( 'issueId' );
+
+    # Sanity check: does assetId exist?
+    my $asset   = WebGUI::Asset->newByDynamicClass( $session, $assetId )
+        || return "Error: Asset [$assetId] could not be instanciated";
+
+    # Sanity check: is asset mailable?
+    unless ( $asset->isa( 'WebGUI::AssetAspect::Mailable' ) ) {
+        return "Error: Asset [$assetId] is not Mailable";
+    }
+
+    # Sanity check: does issue exist?
+    my $issue   = WebGUI::Asset->newByDynamicClass( $session, $issueId )
+        || return "Error: issue [$issueId] for asset [$assetId] could not be instanciated.";
+
+    # All ok, create mailing.
+    require WebGUI::Mailing;
+    my $mailing = WebGUI::Mailing->create( $session, {
+        assetId => $assetId,
+        issueId => $issueId,
+        state   => 'idle',
+    } );
+
+    return $mailing->www_editSave;
 }
 
 #----------------------------------------------------------------------------

lib/WebGUI/Mailing/Bounce.pm

@@ -57,18 +57,106 @@ sub session {
 sub www_bounceReport {
     my $self    = shift;
     my $session = $self->session;
+    my $db      = $session->db;
     my $i18n    = WebGUI::International->new( $session, 'MailingManager' );
-    my $sth = $session->db->read( 'select distinct sentTo from Mailing_email where sentTo is not null' );
 
-    my $output = '<table><tr><th>'.$i18n->get('email').'</th><th>'.$i18n->get('bounce score').'</th></tr>';
+    my $windowSize = 10;
-    while ( my ($email) = $sth->array ) {
+
-        my $score = $self->getBounceScore( $email );
+    my $sql = <<EOSQL;
-        $output .= "<tr><td>$email</td><td>$score</td></tr>";
+    select
+        sentTo,
+        count(status),
+        bounceReason,
+        errorMessage
+    from
+        Mailing_email as t1
+    where
+        status='bounced'
+    and
+        (
+            (select count(*) from Mailing_email as t2 where t1.sentTo=t2.sentTo) < ?
+        or
+            (select lastUpdated from Mailing_email as t2 where t1.sentTo=t2.sentTo order by lastUpdated desc limit ?,1 )
+        )
+    group by
+        sentTo
+    order by
+        sentTo, lastUpdated
+EOSQL
+
+    my $sth = $db->read( $sql, [ $windowSize, $windowSize - 1 ] );
+
+    my $output = '<div class="yui-skin-sam"><div id="tableWrapper"><table id="bounceScoreTable"><thead><tr><th>'
+        . join( '</th><th>',
+            $i18n->get('email'),
+            $i18n->get('bounce score'),
+            $i18n->get('bounce reason'),
+            $i18n->get('bounce message')
+        )
+        . '</th></tr></thead><tbody>';
+    while ( my $values = $sth->arrayRef ) {
+        $output .= '<tr><td>'. join( '</td><td>', @$values ) . '</td></tr>';
     }
-    $output .= '</table>';
+    $output .= '</tbody></table></div></div>';
+
+    $self->addBounceScoreTableJS;
 
     return WebGUI::Mailing::Admin->new( $session )->getAdminConsole->render( $output, $i18n->get( 'bounce scores' ) );
 }
 
+sub addBounceScoreTableJS {
+    my $self    = shift;
+    my ($style, $url) = $self->session->quick( qw{ style url } );
+    my $i18n    = WebGUI::International->new( $self->session, 'MailingManager' );
+
+    my $emailLabel  = $i18n->get('email');
+    my $scoreLabel  = $i18n->get('bounce score');
+    my $reasonLabel = $i18n->get('bounce reason');
+    my $messageLabel= $i18n->get('bounce message');
+
+    my $js = <<EOJS;
+    <script type="text/javascript">
+    //<!--
+        YAHOO.util.Event.onDOMReady( function () {
+            var columnDefs = [
+                { key : "email",            label : "$emailLabel",      sortable : true },
+                { key : "bounceScore",      label : "$scoreLabel",      sortable : true },
+                { key : "bounceReason",     label : "$reasonLabel",     sortable : true },
+                { key : "bounceMessage",    label : "$messageLabel",    sortable : true }
+            ];
+
+            var ds              = new YAHOO.util.DataSource( YAHOO.util.Dom.get('bounceScoreTable') );
+            ds.responseType     = YAHOO.util.DataSource.TYPE_HTMLTABLE;
+            ds.responseSchema   = {
+                fields: [
+                    { key : 'email'                             },
+                    { key : 'bounceScore',  parser : 'number'   },
+                    { key : 'bounceReason'                      },
+                    { key : 'bounceMessage'                     }
+                ]
+            };
+
+            var dt = new YAHOO.widget.DataTable( 'tableWrapper', columnDefs, ds, {
+                sortedBy    : {
+                    key : 'bounceScore',
+                    dir : 'desc'
+                }
+            } );
+        } );
+    //-->
+    </script>
+EOJS
+
+    $style->setLink(   $url->extras('yui/build/datatable/assets/skins/sam/datatable.css'),  { type => 'text/css', rel => 'stylesheet' } );
+    $style->setScript( $url->extras('yui/build/yahoo-dom-event/yahoo-dom-event.js'),        { type => 'text/javascript' } );
+    $style->setScript( $url->extras('yui/build/element/element-min.js'),                    { type => 'text/javascript' } );
+    $style->setScript( $url->extras('yui/build/datasource/datasource-min.js'),              { type => 'text/javascript' } );
+    $style->setScript( $url->extras('yui/build/datatable/datatable-min.js'),                { type => 'text/javascript' } );
+    $style->setRawHeadTags( $js );
+
+    return;
+}
+
+
 1;
 

lib/WebGUI/Mailing/Email.pm

@@ -130,8 +130,7 @@ sub absolutifyURIs {
 
     foreach my $link ( @{ $root->extract_links } ) {
         my ($uri, $element, $attr, $tag) = @{ $link };
-        
+        if ( $uri !~ m{ ^ (?: [a-z]+:// | \# | mailto: ) }xmsi ) {
-        if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) {
             my $new =
                     ( $uri =~ m{ ^ / }xmsi )        # Is url absolute?
                     ? $siteUrl . $uri

lib/WebGUI/Registration/Step/MailingSubscribe.pm

@@ -15,12 +15,15 @@ sub getAvailableMailings {
     my $self    = shift;
     my $session = $self->session;
 
-    my $availableMailings = WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], {
+    my $mailingIds = $self->get( 'includeMailings' );
-        returnObjects   => 1,
-        isa             => 'WebGUI::Asset::Wobject::NewsletterCollection',
-    } );
 
-    return $availableMailings;
+    my @mailings =
+        grep    { defined $_ }
+        map     { WebGUI::Asset->newByDynamicClass( $session, $_ ) }
+                ref $mailingIds eq 'ARRAY' ? @{ $mailingIds } : $mailingIds
+        ;
+
+    return \@mailings;
 }
 
 #-------------------------------------------------------------------
@@ -49,22 +52,32 @@ sub apply {
     return;
 }
 
-##-------------------------------------------------------------------
+#-------------------------------------------------------------------
-#sub crud_definition {
+sub crud_definition {
-#    my $class       = shift;
+    my $class       = shift;
-#    my $session     = shift;
+    my $session     = shift;
-#    my $definition  = $class->SUPER::crud_definition( $session );
+    my $definition  = $class->SUPER::crud_definition( $session );
-#    my $i18n        = WebGUI::International->new( $session, 'Registration_Step_Homepage' );
+    my $i18n        = WebGUI::International->new( $session, 'RegistrationStep_MailingSubscribe' );
-#
+
-#
+    tie my %mailings, 'Tie::IxHash', (
-#    $definition->{ dynamic }->{ urlStorageField     } = {
+        map { $_->getId => $_->getTitle }
-#        fieldType       => 'selectBox',
+            @{
-#        label           => 'Store homepage url in field',
+                WebGUI::Asset->getRoot( $session )->getLineage( ['descendants'], {
-#        options         => \%profileFields,
+                    returnObjects   => 1,
-#    };
+                    isa             => 'WebGUI::Asset::Wobject::NewsletterCollection',
-#
+                } )
-#    return $definition;
+            }
-#}
+    );
+
+    $definition->{ dynamic }->{ includeMailings } = {
+        fieldType       => 'checkList',
+        label           => $i18n->get('Include newsletters'),
+        options         => \%mailings,
+        vertical        => 1,
+    };
+
+    return $definition;
+}
 
 #-------------------------------------------------------------------
 sub getSummaryTemplateVars {
@@ -119,7 +132,7 @@ sub getViewVars {
     }
     else {
         # The step hasn't been done yet.
-        @subscribeMailings = grep { $_->isSubscribed( $user ) } @{ $availableMailings };
+        @subscribeMailings = map { $_->getId } grep { $_->isSubscribed( $user ) } @{ $availableMailings };
     }
 
     # Create lookup table
@@ -171,10 +184,7 @@ sub updateFromFormPost {
     my $self    = shift;
     my $session = $self->session;
 
-    $self->SUPER::updateFromFormPost;
+    return $self->SUPER::updateFromFormPost;
-
-#    $self->update( {
-#    } );
 }
 
 #-------------------------------------------------------------------

lib/WebGUI/i18n/Dutch/AssetAspect_Subscriber.pm

@@ -54,14 +54,17 @@ our $I18N = {
     },
 
     'subscription successful' => {
-        message => 'Uw inschrijving is geslaagd. <a href="%s">Terug naar de site</a>',
+        message => 'Uw inschrijving is geslaagd.',
     },
     'unsubscription successful' => {
-        message => 'Uw uitschrijving is geslaagd. <a href="%s">Terug naar de site</a>',
+        message => 'Uw uitschrijving is geslaagd.',
     },
     'wrong code' => {
         message => 'De verificatiecode in de link is onbekend, al gebruikt of verlopen. Als u zich wilt in- of uitschrijven probeer dit dan opnieuw of neem contact op met de websitebeheerders.',
     },
+    'confirm mutation template' => {
+        message => 'Mutatie bevestigings template',
+    },
 };
 
 1;

lib/WebGUI/i18n/Dutch/Asset_NewsletterCollection.pm

@@ -6,14 +6,26 @@ our $I18N = {
     assetName => {
         message => 'Nieuwsbrief collectie',
     },
+    'subscribe' => {
+        message => 'inschrijven',
+    },
+    'unsubscribe' => {
+        message => 'uitschrijven',
+    },
     'template' => {
         message => 'Sjabloon',
     },
     'number of recent issues' => {
-        message => 'Aantal recente uitgaven',
+        message => 'Aantal recente nieuwsbrieven',
+    },
+    'useHoneypot label' => {
+        message => q|Gebruik honeypot|,
+        lastUpdated => 0,
+    },
+    'useHoneypot description' => {
+        message => q|Gebruik honeypot om spam te voorkomen.|,
+        lastUpdated => 0,
     },    
-    
 };
 
 1;
-

lib/WebGUI/i18n/Dutch/MailingManager.pm

@@ -100,6 +100,14 @@ our $I18N = {
     'generate mailing' => {
         message => 'Genereer mailing',
     },
+
+    'bounce reason' => {
+        message => 'Laatste bounce oorzaak',
+    },
+
+    'bounce message' => {
+        message => 'Laatste bounce omschrijving',
+    },
 };
 
 1;

lib/WebGUI/i18n/Dutch/RegistrationStep_MailingSubscribe.pm

@@ -4,10 +4,13 @@ use strict;
 
 our $I18N = {
     'Subscribe to mailings' => {
-        message => 'Abonneren op nieuwsbrieven',
+        message => 'Ontvang deze nieuwsbrief',
     },
     'Subscribe to this mailing' => {
-        message => 'Abonneer op deze nieuwsbrief',
+        message => 'Ontvang deze nieuwsbrief',
+    },
+    'Include newsletters' => {
+        message => 'Selecteerbare nieuwsbrieven',
     },
 };
 

lib/WebGUI/i18n/English/AssetAspect_Subscriber.pm

@@ -34,7 +34,6 @@ our $I18N = {
         message => 'Subscription',
     },
 
-
     'subscribe' => {
         message => 'Subscribe',
     },
@@ -54,15 +53,18 @@ our $I18N = {
     },
 
     'subscription successful' => {
-        message => 'You are succesfully subscribed. <a href="%s">Back to site</a>',
+        message => 'You are succesfully subscribed.',
     },
     'unsubscription successful' => {
-        message => 'You are succesfully unsubscribed. <a href="%s">Back to site</a>',
+        message => 'You are succesfully unsubscribed.',
     },
     'wrong code' => {
         message => 'The verification code you supplied is either unknown, already used or expired. Please try again to (un)subscribe or contact the site administrators.',
     },
 
+    'confirm mutation template' => {
+        message => 'Mutation confirmation template',
+    },
 };
 
 1;

lib/WebGUI/i18n/English/Asset_NewsletterCollection.pm

@@ -18,7 +18,14 @@ our $I18N = {
     'number of recent issues' => {
         message => 'Number of recent issues',
     },
-    
+    'useHoneypot label' => {
+        message => q|Use honeypot|,
+        lastUpdated => 0,
+    },
+    'useHoneypot description' => {
+        message => q|Use honeypot to verify humanity.|,
+        lastUpdated => 0,
+    },    
 };
 
 1;

lib/WebGUI/i18n/English/MailingManager.pm

@@ -100,6 +100,14 @@ our $I18N = {
     'generate mailing' => {
         message => 'Generate mailing',
     },
+
+    'bounce reason' => {
+        message => 'Latest bounce reason',
+    },
+
+    'bounce message' => {
+        message => 'Latest bounce message',
+    },
 };
 
 1;

lib/WebGUI/i18n/English/RegistrationStep_MailingSubscribe.pm

@@ -9,6 +9,9 @@ our $I18N = {
     'Subscribe to this mailing' => {
         message => 'Subscribe to this mailing',
     },
+    'Include newsletters' => {
+        message => 'Include newsletters',
+    },
 };
 
 1;

sbin/importSpecialState.pl

@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 
 $|++; # disable output buffering
-our ($webguiRoot, $configFile, $state, $emailFile, $groupId );
+our ($webguiRoot, $configFile, $state, $emailFile, $groupId, $existingUsersGroupId );
 
 BEGIN {
     $webguiRoot = "..";
@@ -15,12 +15,16 @@ use WebGUI::Session;
 use WebGUI::User;
 use WebGUI::User::SpecialState;
 
+# Set default value
+$existingUsersGroupId = '';
+
 # Get parameters here, including $help
 GetOptions(
-    'configFile=s'  => \$configFile,
+    'configFile=s'  		=> \$configFile,
-    'groupId=s'     => \$groupId,
+    'groupId=s'     		=> \$groupId,
-    'state=s'       => \$state,
+    'existingUsersGroupId=s'	=> \$existingUsersGroupId,
-    'emailFile=s'   => \$emailFile,
+    'state=s'       		=> \$state,
+    'emailFile=s'   		=> \$emailFile,
 );
 
 my $session = start( $webguiRoot, $configFile );
@@ -40,18 +44,24 @@ while ( my $email = <$fh> ) {
     my $user = WebGUI::User->newByEmail( $session, $email );
     if ( $user ) {
         print "\tEmail already has account. Skipping.\n";
+	if ( $existingUsersGroupId ) {
+	    print "\tAdding user to group $existingUsersGroupId\n";
+	    $user->addToGroups( [ $existingUsersGroupId ] );
+	}
+	else {
+	    print "\tAdding user to group $groupId\n";
+	    $user->addToGroups( [ $groupId ] );
+	}
     }
     else {
         print "\tEmail has no account, creating special state $state.\n";
         $user = WebGUI::User::SpecialState->create( $session );
         $user->update( { email => $email } );
         $user->addSpecialState( $state );
+	print "\tAdding user to group $groupId\n";
+	$user->addToGroups( [ $groupId ] );
     }
 
-    print "\tAdding user to group $groupId\n";
-
-    $user->addToGroups( [ $groupId ] );
-
 }
 print "Done\n\n";
 
@@ -120,6 +130,22 @@ The WebGUI config file to use. Only the file name needs to be specified,
 since it will be looked up inside WebGUI's configuration directory.
 This parameter is required.
 
+=item B<--groupId>
+
+Add users to this group. If no existingUsersGroupId is given, all users, both new and existing users, are added to this group. If the --existingUsersGroupId is given, new users are added to this group, existing users are added to the existingUsersGroupId.
+
+=item B<--existingUsersGroupId>
+
+Add existing users to this group.
+
+=item B<--state>
+
+Set the so called specialState for this user. For all users disabeled accounts are created. SpecialState accounts can be transformed into regular accounts using the webgui_registration content handler. The special states are crm or Subscriber, for a user added via the crm or a newsletter subscription respectively. 
+
+=item B<--emailFile>
+
+A text file with an emailadress on every line. 
+
 =item B<--help>
 
 Shows a short summary and usage
@@ -132,7 +158,7 @@ Shows this document
 
 =head1 AUTHOR
 
-Copyright 2001-2009 Plain Black Corporation.
+Copyright 2010-2011 United Knowledge B.V.
 
 =cut
 

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,75 @@ addTemplateColumnToNewsletterCollection( $session );
 addRecentColumnToNewsletterCollection( $session );
 renamespaceTemplates( $session );
 addSpecialStateTable( $session );
+addListNameColumn( $session );
 addRegistrationSteps( $session );
+addConfirmationTemplateColumn( $session );
+addSentToIndex( $session );
+addUseHoneypotColumn( $session );
 
 finish($session);
 
+#-------------------------------------------------------------------------------
+sub addConfirmationTemplateColumn {
+    my $session = shift;
+    my $db      = $session->db;
+
+    print "\tAdding column for mutation confirmation template...";
+
+    my $hasColumn = $db->quickScalar( 'show columns from assetAspectSubscriber where Field = ?', [
+        'confirmMutationTemplateId',
+    ] );
+
+    unless ( $hasColumn ) {
+        $db->write(
+            'alter table assetAspectSubscriber add column confirmMutationTemplateId char(22) binary not null default ?',
+            [
+                'WUk-wEhGiF8dcEogrJfrfg',
+            ]
+        );
+
+        $db->write(
+            'update assetAspectSubscriber set confirmMutationTemplateId=? where confirmMutationTemplateId is null',
+            [
+                'WUk-wEhGiF8dcEogrJfrfg',
+            ]
+        );
+    }
+
+    print "Done.\n";
+}
+
+#----------------------------------------------------------------------------
+sub addSentToIndex {
+    my $session = shift;
+    my $db      = $session->db;
+
+    print "\tAdding index to column Mailing_email.sentTo...";
+
+    my @indexes = $db->buildArray('show indexes from Mailing_email where Column_name=?',['sentTo']);
+
+    if ( @indexes == 0 ) {
+        $db->write('alter table Mailing_email add index(sentTo)');
+    }
+
+    print "Done.\n";
+}
+
+#----------------------------------------------------------------------------
+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;
@@ -60,17 +125,17 @@ sub installSubscriberAspectTable {
 
     $session->db->write(<<EOSQL);
         create table if not exists assetAspectSubscriber (
-            assetId                     char(22)    binary  not null,
+            assetId                        char(22)    binary  not null,
-            revisionDate                bigint(20)          not null,
+            revisionDate                   bigint(20)          not null,
-            subscriptionGroupId         char(22)    binary,
+            subscriptionGroupId            char(22)    binary,
-            subscriptionEnabled         tinyint(1)          not null default 0,
+            subscriptionEnabled            tinyint(1)          not null default 0,
-            alwaysConfirmSubscription   tinyint(1)          not null default 0,
+            alwaysConfirmSubscription      tinyint(1)          not null default 0,
-            allowAnonymousSubscription  tinyint(1)          not null default 0,
+            allowAnonymousSubscription     tinyint(1)          not null default 0,
             confirmationRequiredTemplateId char(22)    binary,
-            confirmationEmailTemplateId char(22)    binary,
+            confirmationEmailTemplateId    char(22)    binary,
-            confirmationEmailSubject    varchar(255),
+            confirmationEmailSubject       varchar(255),
-            noMutationEmailTemplateId   char(22)    binary,
+            noMutationEmailTemplateId      char(22)    binary,
-            noMutationEmailSubject      varchar(255),
+            noMutationEmailSubject         varchar(255),
             primary key( assetId, revisionDate )
         );
 EOSQL
@@ -103,6 +168,7 @@ sub installNewsletterCollection {
         create table if not exists NewsletterCollection (
             assetId                     char(22)    binary  not null,
             revisionDate                bigint(20)          not null,
+            useHoneypot                 tinyint(1)          default 0,
             primary key( assetId, revisionDate )
         );
 EOSQL
@@ -288,7 +354,27 @@ sub addRegistrationSteps {
     print "Done.\n";
 
 }
+#----------------------------------------------------------------------------
+sub addUseHoneypotColumn {
+    my $session = shift;
 
+    my $db      = $session->db;
+
+    print "\tAdding useHoneypot column...";
+
+    my @columns = $db->buildArray( 'show columns from NewsletterCollection' );
+
+   if ( ! grep { $_ eq 'useHoneypot' } @columns ) {
+       $db->write( 'alter table NewsletterCollection add column useHoneypot tinyint(1) default 0' );
+       $db->write( 'update NewsletterCollection set useHoneypot = 0 where useHoneypot is null' );
+
+       print "Done\n";
+
+   }
+   else {
+       print "Skipping\n";
+   }
+}
 #----------------------------------------------------------------------------
 sub start {
     my $webguiRoot  = shift;

sbin/newsletter-transport.pl

@@ -1,60 +1,102 @@
-#!/data/wre/prereqs/bin/perl
+#!/usr/bin/perl
 
 BEGIN {
     unshift @INC, qw(
         /data/custom/webgui_newsletter/lib
         /data/WebGUI/lib
+        /data/custom/customlib_honeypot/lib
     );
 }
 
 use strict;
+use warnings;
+use 5.010;
 
-use Mail::DeliveryStatus::BounceParser;
+use WebGUI::MailCommand;
-use WebGUI::Mailing::Email;
 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;
+# Startup
-my ( $mailId, $command )    = $user =~ m{^(.+)-([^-]+)$}i;
+{
+    my ( $configFile, $command, $id, $sender, $senderIp ) = getCredentials();
 
-my $configFile      = $configs{ $domain };
+    if ( WebGUI::MailCommand::isValidCommand( $command ) ) {
-my $validCommand    = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm };
+        my $session = openSession( $webguiRoot, $configFile );
+        no warnings 'once';
+        *{ WebGUI::Session::Env::getIp } = sub {
+            return $senderIp || '127.0.0.1';
+        };
 
-unless ( $configFile && $validCommand ) {
+        WebGUI::MailCommand::processCommand( $session, $command, $id, $sender );
-#    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) {
+        closeSession( $session );
-        $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( 'about to register as bounced' );
-        $email->registerBounced( $reason, $message );
     }
     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;
+}