"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "DADA/App/WebServices.pm" between
dada-11_14_1.tar.gz and dada-11_14_2.tar.gz

About: Dada is a web-based electronic (mass) mailing list management system.

WebServices.pm  (dada-11_14_1):WebServices.pm  (dada-11_14_2)
package DADA::App::WebServices; package DADA::App::WebServices;
use strict; use strict;
use lib qw( use lib qw(./ ../ ../../ ../../DADA ../perllib);
../../
../../DADA/perllib
);
use Carp qw(carp croak); use Carp qw(carp croak);
$CARP::Verbose = 1;
use DADA::Config qw(!:DEFAULT); use DADA::Config qw(!:DEFAULT);
use JSON; use JSON;
use DADA::Config; use DADA::Config;
use DADA::App::Guts; use DADA::App::Guts;
use DADA::MailingList::Subscribers; use DADA::MailingList::Subscribers;
use DADA::MailingList::Settings; use DADA::MailingList::Settings;
use Digest::SHA qw(hmac_sha256_base64); use Digest::SHA qw(hmac_sha256_base64);
use Try::Tiny; use Try::Tiny;
use CGI (qw/:oldstyle_urls/); use CGI (qw/:oldstyle_urls/);
my $calculated_digest = undef; my $calculated_digest = undef;
use vars qw($AUTOLOAD); use vars qw($AUTOLOAD);
my $t = $DADA::Config::DEBUG_TRACE->{DADA_App_WebServices}; my $t = $DADA::Config::DEBUG_TRACE->{DADA_App_WebServices};
my %allowed = ( test => 0, ); my %allowed = (
test => 0,
ls_obj => undef,
r_list => undef,
r_service => undef,
r_public_key => undef,
r_digest => undef,
r_cgi_obj => undef,
global_level => undef,
i_private_api_key => undef,
);
sub new { sub new {
my $that = shift; my $that = shift;
my $class = ref($that) || $that; my $class = ref($that) || $that;
my $self = { my $self = {
_permitted => \%allowed, _permitted => \%allowed,
%allowed, %allowed,
}; };
bless $self, $class; bless $self, $class;
my %args = (@_); my %args = (@_);
$self->_init( \%args ); $self->_init( \%args );
return $self; return $self;
} }
sub AUTOLOAD { sub AUTOLOAD {
my $self = shift; my $self = shift;
my $type = ref($self) my $type = ref($self)
or croak "$self is not an object"; or croak "$self is not an object";
return if(substr($AUTOLOAD, -7) eq 'DESTROY'); return if ( substr( $AUTOLOAD, -7 ) eq 'DESTROY' );
my $name = $AUTOLOAD; my $name = $AUTOLOAD;
$name =~ s/.*://; #strip fully qualifies portion $name =~ s/.*://; #strip fully qualifies portion
unless ( exists $self->{_permitted}->{$name} ) { unless ( exists $self->{_permitted}->{$name} ) {
croak "Can't access '$name' field in object of class $type"; croak "Can't access '$name' field in object of class $type";
} }
if (@_) { if (@_) {
return $self->{$name} = shift; return $self->{$name} = shift;
} }
skipping to change at line 77 skipping to change at line 88
sub _init { sub _init {
my $self = shift; my $self = shift;
$self->{q} = CGI->new; $self->{q} = CGI->new;
} }
sub request { sub request {
my $self = shift; my $self = shift;
my $status = 1; my $status = 1;
my $errors = {}; my $errors = {};
my ($args) = @_; my ($args) = @_;
for ( '-list', '-service', '-public_key', '-digest', '-cgi_obj' ) { for ( '-list', '-service', '-public_key', '-digest', '-cgi_obj' ) {
my $param = $_; my $param = $_;
$param =~ s/^\-//; $param =~ s/^\-//;
if ( !exists( $args->{$_} ) ) { if ( !exists( $args->{$_} ) ) {
$status = 0; $status = 0;
$errors->{ 'missing_' . $param }; $errors->{ 'missing_' . $param } = 1;
warn 'passed param: ' . $_ . ' => ' . $param warn 'passed param: ' . $_ . ' => ' . $param
if $t; if $t;
} }
else { else {
$self->{$param} = strip($args->{$_}); $args->{$_} = strip( $args->{$_} );
} }
}
if ( $self->check_list() == 0 ) { warn $_ . ' => ' . $args->{$_}
$status = 0; if $t;
$errors->{'invalid_list'};
} }
warn '$status: ' . $status
if $t;
if ( $status == 1 ) { if ( $status == 1 ) {
$self->{ls} = DADA::MailingList::Settings->new( { -list => $self->{list} $self->r_list( $args->{-list} );
} ); $self->r_service( $args->{-service} );
( $status, $errors ) = $self->check_request(); $self->r_public_key( $args->{-public_key} );
$self->r_digest( $args->{-digest} );
$self->r_cgi_obj( $args->{-cgi_obj} );
} }
my $r = {}; warn '$self->check_list(): ' . $self->check_list();
warn '$self->r_list: ' . $self->r_list;
warn '$self->r_public_key: ' . $self->r_public_key;
warn '$DADA::Config::GLOBAL_API_OPTIONS->{public_key}: '
. $DADA::Config::GLOBAL_API_OPTIONS->{public_key};
if ( $status == 1 ) { if (
if ( $self->{service} eq 'validate_subscription' ) { ( $self->check_list() == 1 )
$r = $self->validate_subscription(); && ( $self->r_public_key eq
} $DADA::Config::GLOBAL_API_OPTIONS->{public_key} )
elsif ( $self->{service} eq 'subscription' ) { )
$r = $self->subscription(); {
}
elsif ( $self->{service} eq 'unsubscription' ) { warn 'here.';
$r = $self->unsubscription();
} $self->ls_obj(
elsif ( $self->{service} eq 'mass_email' ) { DADA::MailingList::Settings->new( { -list => $self->r_list } ) );
$r = $self->mass_email(); $self->global_level(1);
} $self->i_private_api_key(
elsif ( $self->{service} eq 'settings' ) { $DADA::Config::GLOBAL_API_OPTIONS->{private_key} );
$r = $self->settings();
} }
elsif( $self->{service} eq 'update_settings') { elsif ( $self->check_list() == 1 ) {
$r = $self->update_settings(); $self->ls_obj(
} DADA::MailingList::Settings->new( { -list => $self->r_list } ) );
elsif( $self->{service} eq 'update_profile_fields') { $self->global_level(0);
$r = $self->update_profile_fields(); $self->i_private_api_key( $self->ls_obj->param('private_api_key') );
}
else {
# If there's a list that's passed, but it's invalid, this shouldn't workL
if (
( $self->r_list eq undef )
&& ( $self->r_public_key eq
$DADA::Config::GLOBAL_API_OPTIONS->{public_key} )
)
{
$self->global_level(1);
# Well, OK...
$self->i_private_api_key(
$DADA::Config::GLOBAL_API_OPTIONS->{private_key} );
} }
else { else {
$r = { $status = 0;
status => 0, $errors->{'invalid_list'} = 1;
errors => { invalid_request => 1 }
};
} }
} }
else {
warn 'global_level: ' . $self->global_level
if $t;
warn '$status: ' . $status
if $t;
my $r = {};
if ( $status == 0 ) {
$r = { $r = {
status => 0, status => 0,
errors => $errors, errors => $errors,
}; };
} }
else {
# we're reusing these, below:
undef $status;
undef $errors;
my ( $status, $errors ) = $self->check_request();
if ( $status == 1 ) {
if ( $self->r_service eq 'validate_subscription' ) {
$r = $self->validate_subscription();
}
elsif ( $self->r_service eq 'subscription' ) {
$r = $self->subscription();
}
elsif ( $self->r_service eq 'unsubscription' ) {
$r = $self->unsubscription();
}
elsif ( $self->r_service eq 'mass_email' ) {
$r = $self->mass_email();
}
elsif ( $self->r_service eq 'settings' ) {
$r = $self->settings();
}
elsif ( $self->r_service eq 'update_settings' ) {
$r = $self->update_settings();
}
elsif ( $self->r_service eq 'update_profile_fields' ) {
$r = $self->update_profile_fields();
}
elsif ( $self->r_service eq 'create_new_list' ) {
$r = $self->create_new_list();
}
else {
$r = {
status => 0,
errors => {
invalid_request => 1
}
};
}
}
else {
$r = {
status => 0,
errors => $errors,
};
}
}
if ($t) { if ($t) {
$r->{og_path_info} = $self->{cgi_obj}->path_info(); $r->{r_path_info} = $self->r_cgi_obj->path_info();
$r->{og_service} = $self->{service}; $r->{r_service} = $self->r_service;
$r->{og_query} = $self->{cgi_obj}->query_string(); $r->{r_query} = $self->r_cgi_obj->query_string();
$r->{og_digest} = $self->{digest}; $r->{r_digest} = $self->r_digest;
$r->{calculated_digest} = $calculated_digest; $r->{calculated_digest} = $calculated_digest;
$r->{public_api_key} = $self->{ls}->param('public_api_key'); $r->{r_public_key} = $self->r_public_key;
$r->{private_api_key} = $self->{ls}->param('private_api_key'); $r->{i_private_api_key} = $self->i_private_api_key;
if ( exists( $self->{ls} ) ) {
$r->{public_api_key} = $self->{ls}->param('public_api_key');
$r->{private_api_key} = $self->{ls}->param('private_api_key');
}
} }
my $headers = { my $headers = {
-type => 'application/json', -type => 'application/json',
'-Cache-Control' => 'no-cache, must-revalidate', '-Cache-Control' => 'no-cache, must-revalidate',
-expires => 'Mon, 26 Jul 1997 05:00:00 GMT', -expires => 'Mon, 26 Jul 1997 05:00:00 GMT',
}; };
my $json = JSON->new->allow_nonref; my $json = JSON->new->allow_nonref;
return ($headers, $json->pretty->encode($r)); return ( $headers, $json->pretty->encode($r) );
} }
sub validate_subscription { sub validate_subscription {
my $self = shift; my $self = shift;
my $addresses = $self->{cgi_obj}->param('addresses'); my $addresses = $self->r_cgi_obj->param('addresses');
my $lh = DADA::MailingList::Subscribers->new( { -list => $sel f->{list} } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $self->r_list } );
my $json = JSON->new; my $json = JSON->new;
my $decoded_addresses = $json->decode($addresses); my $decoded_addresses = $json->decode($addresses);
my $f_addresses = $lh->filter_subscribers_w_meta( my $f_addresses = $lh->filter_subscribers_w_meta(
{ {
-emails => $decoded_addresses, -emails => $decoded_addresses,
-type => 'list', -type => 'list',
} }
); );
for (@$f_addresses) { for (@$f_addresses) {
# We don't need these: # We don't need these:
delete( $_->{csv_str} ); delete( $_->{csv_str} );
} }
return { return {
status => 1, status => 1,
results => $f_addresses results => $f_addresses
} };
} }
sub subscription { sub subscription {
my $self = shift; my $self = shift;
my $addresses = $self->{cgi_obj}->param('addresses'); my $addresses = $self->r_cgi_obj->param('addresses');
my $lh = DADA::MailingList::Subscribers->new( { -list => $s my $lh = DADA::MailingList::Subscribers->new( { -list => $self->r_list } );
elf->{list} } );
my $json = JSON->new; my $json = JSON->new;
my $decoded_addresses = $json->decode($addresses); my $decoded_addresses = $json->decode($addresses);
my $new_email_count = 0; my $new_email_count = 0;
my $skipped_email_count = 0; my $skipped_email_count = 0;
my $not_members_fields_options_mode = 'preserve_if_defined'; my $not_members_fields_options_mode = 'preserve_if_defined';
my $f_addresses = $lh->filter_subscribers_w_meta( my $f_addresses = $lh->filter_subscribers_w_meta(
{ {
-emails => $decoded_addresses, -emails => $decoded_addresses,
skipping to change at line 244 skipping to change at line 330
-type => 'list', -type => 'list',
} }
); );
} }
#-fields_options_mode => undef, #-fields_options_mode => undef,
$skipped_email_count = $skipped_email_count + $filtered_out; $skipped_email_count = $skipped_email_count + $filtered_out;
return { return {
status => 1, status => 1,
results => { results => {
subscribed_addresses => $new_email_count, subscribed_addresses => $new_email_count,
skipped_addresses => $skipped_email_count, skipped_addresses => $skipped_email_count,
} }
}; };
} }
sub unsubscription { sub unsubscription {
my $self = shift; my $self = shift;
my $addresses = $self->{cgi_obj}->param('addresses'); my $addresses = $self->r_cgi_obj->param('addresses');
my $lh = DADA::MailingList::Subscribers->new( { -list => $s my $lh = DADA::MailingList::Subscribers->new( { -list => $self->r_list } );
elf->{list} } );
my $json = JSON->new; my $json = JSON->new;
my $decoded_addresses = $json->decode($addresses); my $decoded_addresses = $json->decode($addresses);
my $removed_email_count = 0; my $removed_email_count = 0;
my $skipped_email_count = 0; my $skipped_email_count = 0;
my $blacklisted_count = 0; my $blacklisted_count = 0;
my $f_addresses = $lh->filter_subscribers_w_meta( my $f_addresses = $lh->filter_subscribers_w_meta(
{ {
-emails => $decoded_addresses, -emails => $decoded_addresses,
-type => 'list', -type => 'list',
skipping to change at line 283 skipping to change at line 369
for (@$f_addresses) { for (@$f_addresses) {
if ( $_->{status} == 0 && $_->{errors}->{subscribed} == 1 ) { if ( $_->{status} == 0 && $_->{errors}->{subscribed} == 1 ) {
push( @$unsubscribe_these, $_->{email} ); push( @$unsubscribe_these, $_->{email} );
} }
else { else {
$filtered_out++; $filtered_out++;
} }
} }
if ( scalar(@$unsubscribe_these) > 0 ) { if ( scalar(@$unsubscribe_these) > 0 ) {
( $removed_email_count, $blacklisted_count ) = $lh->admin_remove_subscri ( $removed_email_count, $blacklisted_count ) =
bers( $lh->admin_remove_subscribers(
{ {
-addresses => $unsubscribe_these, -addresses => $unsubscribe_these,
-type => 'list', -type => 'list',
} }
); );
} }
$skipped_email_count = $skipped_email_count + $filtered_out; $skipped_email_count = $skipped_email_count + $filtered_out;
return { return {
status => 1, status => 1,
results => { results => {
unsubscribed_addresses => $removed_email_count, unsubscribed_addresses => $removed_email_count,
skipped_addresses => $skipped_email_count, skipped_addresses => $skipped_email_count,
} }
}; };
} }
sub mass_email { sub mass_email {
my $self = shift; my $self = shift;
my $subject = $self->{cgi_obj}->param('subject'); my $subject = $self->r_cgi_obj->param('subject');
my $format = $self->{cgi_obj}->param('format'); my $format = $self->r_cgi_obj->param('format');
my $message = $self->{cgi_obj}->param('message'); my $message = $self->r_cgi_obj->param('message');
my $test = $self->{cgi_obj}->param('test') || 0; my $test = $self->r_cgi_obj->param('test') || 0;
my $type = 'text/plain'; my $type = 'text/plain';
if ( $format =~ m/html/i ) { if ( $format =~ m/html/i ) {
$type = 'text/html'; $type = 'text/html';
} }
my $qq = CGI->new(); my $qq = CGI->new();
$qq->delete_all(); $qq->delete_all();
$qq->param('Subject', $subject); $qq->param( 'Subject', $subject );
if($type eq 'text/html'){ if ( $type eq 'text/html' ) {
$qq->param('html_message_body', $message); $qq->param( 'html_message_body', $message );
} }
else { else {
# Say that we don't have any HTML # Say that we don't have any HTML
$qq->param('content_from', 'none'); $qq->param( 'content_from', 'none' );
# but we do have plaintext
$qq->param('plaintext_content_from', 'text');
# and make sure that's found
$qq->param('text_message_body', $message);
}
$qq->param('f', 'send_email');
$qq->param('draft_role', 'draft');
require DADA::App::MassSend;
my $dam = DADA::App::MassSend->new({-list => $self->{list}});
my $draft_id = $dam->save_as_draft(
{
-cgi_obj => $qq,
-list => $self->{list},
-json => 0,
} # but we do have plaintext
); $qq->param( 'plaintext_content_from', 'text' );
# and make sure that's found
$qq->param( 'text_message_body', $message );
}
$qq->param( 'f', 'send_email' );
$qq->param( 'draft_role', 'draft' );
require DADA::App::MassSend;
my $dam = DADA::App::MassSend->new( { -list => $self->r_list } );
my $draft_id = $dam->save_as_draft(
{
-cgi_obj => $qq,
-list => $self->r_list,
-json => 0,
my $process;
if($test == 1){
$process = 'test';
} }
else { );
$process = 1;
my $process;
if ( $test == 1 ) {
$process = 'test';
}
else {
$process = 1;
}
# to fetch a draft, I need id, list and role (lame)
my $c_r = $dam->construct_and_send(
{
-draft_id => $draft_id,
-screen => 'send_email',
-role => 'draft',
-process => $process,
} }
# to fetch a draft, I need id, list and role (lame) );
my $c_r = $dam->construct_and_send( $dam->delete_draft($draft_id);
{
-draft_id => $draft_id,
-screen => 'send_email',
-role => 'draft',
-process => $process,
}
);
$dam->delete_draft($draft_id);
if ( $c_r->{status} == 0 ) { if ( $c_r->{status} == 0 ) {
return { return {
status => 0, status => 0,
results => { errors => {
error => $c_r->{errors}, mass_email_error => $c_r->{errors},
} }
}; };
} }
else { else {
return { return {
status => 1, status => 1,
results => { results => {
message_id => $self->_massaged_key($c_r->{mid}), message_id => $self->_massaged_key( $c_r->{mid} ),
} }
}; };
} }
} }
sub settings { sub settings {
my $self = shift; my $self = shift;
warn 'settings called' warn 'settings called'
if $t; if $t;
return { return {
status => 1, status => 1,
results => { results => {
settings => $self->{ls}->get() settings => $self->ls_obj->get()
} }
}; };
} }
sub update_settings { sub update_settings {
my $self = shift; my $self = shift;
my $json = JSON->new->allow_nonref; my $json = JSON->new->allow_nonref;
my $r = {}; my $r = {};
my $settings = $self->{cgi_obj}->param('settings'); my $settings = $self->r_cgi_obj->param('settings');
$settings = $json->decode($settings); $settings = $json->decode($settings);
try { try {
$self->{ls}->save( $self->ls_obj->save(
{ {
-settings => $settings -settings => $settings
} }
); );
$r = { $r = {
status => 1, status => 1,
results => {saved => 1}, results => {
saved => 1
},
}; };
} catch { }
$r = { catch {
status => 0, $r = {
errors => $_ status => 0,
errors => {
error => $_
},
}; };
}; };
return $r; return $r;
} }
sub update_profile_fields { sub update_profile_fields {
my $self = shift; my $self = shift;
my $lh = DADA::MailingList::Subscribers->new( { -list => $self->{list} } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $self->r_list } );
my $json = JSON->new->allow_nonref; my $json = JSON->new->allow_nonref;
my $r = {}; my $r = {};
my $email = $self->{cgi_obj}->param('email'); my $email = $self->r_cgi_obj->param('email');
$email = $json->decode($email); $email = $json->decode($email);
$email = cased( xss_filter($email) ); $email = cased( xss_filter($email) );
if ( check_for_valid_email($email) == 1 ) { if ( check_for_valid_email($email) == 1 ) {
return { return {
status => 0, status => 0,
errors => 'invalid_email', errors => {
email => $email, invalid_email => 1,
}; },
} email => $email,
};
}
try { try {
require DADA::Profile; require DADA::Profile;
my $prof = DADA::Profile->new( { -email => $email } ); my $prof = DADA::Profile->new( { -email => $email } );
my $profile_fields = $self->{cgi_obj}->param('profile_fields'); my $profile_fields = $self->r_cgi_obj->param('profile_fields');
$profile_fields = $json->decode($profile_fields); $profile_fields = $json->decode($profile_fields);
#warn 'pf:' . $profile_fields; #warn 'pf:' . $profile_fields;
# check to see if profiles exist? # check to see if profiles exist?
# Actually, it doesnm't matter to me if the profile exists or not, # Actually, it doesnm't matter to me if the profile exists or not,
my $new_fields = {}; my $new_fields = {};
for my $nfield ( @{ $lh->subscriber_fields() } ) { for my $nfield ( @{ $lh->subscriber_fields() } ) {
if ( exists( $profile_fields->{$nfield} ) ) { if ( exists( $profile_fields->{$nfield} ) ) {
$new_fields->{$nfield} = $profile_fields->{$nfield}; $new_fields->{$nfield} = $profile_fields->{$nfield};
} }
} }
my $dpf = DADA::Profile::Fields->new({-email => $email}); my $dpf = DADA::Profile::Fields->new( { -email => $email } );
my $orig = $dpf->get; my $orig = $dpf->get;
delete($orig->{email}); delete( $orig->{email} );
delete($orig->{email_name}); delete( $orig->{email_name} );
delete($orig->{email_domain}); delete( $orig->{email_domain} );
$dpf->insert( $dpf->insert(
{ {
-email => $email, -email => $email,
-fields => $new_fields, -fields => $new_fields,
} }
); );
$r = { $r = {
status => 1, status => 1,
results => { results => {
saved => 1, saved => 1,
email => $email, email => $email,
profile_fields => $new_fields, profile_fields => $new_fields,
previous_profile_fields => $orig, previous_profile_fields => $orig,
}, },
}; };
} catch { }
catch {
$r = { $r = {
status => 0, status => 0,
errors => $_ errors => {
error => $_,
}
}; };
}; };
return $r; return $r;
} }
sub create_new_list {
my $self = shift;
warn 'create_new_list called'
if $t;
my $json = JSON->new->allow_nonref;
my $r = {};
my $status = 0;
my $errors = {};
=pod
# OK, so remember we need to do a list quota check:
if(strip($DADA::Config::LIST_QUOTA) eq '') {
$DADA::Config::LIST_QUOTA = undef;
}
# Special:
if($DADA::Config::LIST_QUOTA == 0){
$DADA::Config::LIST_QUOTA = undef;
}
if ( defined($DADA::Config::LIST_QUOTA)
&& ( ( $#t_lists + 1 ) >= $DADA::Config::LIST_QUOTA ) )
{
return user_error(
{ -list => $list, -error => "over_list_quota" } );
}
my @available_lists = DADA::App::Guts::available_lists();
my $lists_exist = $#available_lists + 1;
=cut
my $settings = $self->r_cgi_obj->param('settings');
$settings = $json->decode($settings);
warn '$self->r_cgi_obj->param(\'options\'): '
. $self->r_cgi_obj->param('options');
my $options = $self->r_cgi_obj->param('options');
$options = $json->decode($options);
use Data::Dumper;
warn '$options: ' . Dumper($options);
my $list_exists = check_if_list_exists( -List => $settings->{list} );
my ( $list_errors, $flags ) = check_list_setup(
-fields => {
list => $settings->{list},
list_name => $settings->{list_name},
list_owner_email => $settings->{list_owner_email},
password => $settings->{password},
retype_password => $settings->{password},
info => $settings->{info},
privacy_policy => $settings->{privacy_policy},
physical_address => $settings->{physical_address},
consent => $settings->{consent},
}
);
if ( $list_errors >= 1 ) {
$status = 0;
$errors = $flags;
for ( keys %$errors ) {
if ( $errors->{$_} != 1 ) {
delete( $errors->{$_} );
}
}
return {
status => $status,
results => {
error => $errors,
}
};
}
elsif ( $list_exists >= 1 ) {
return {
status => 0,
errors => {
list_exists => 1,
},
};
}
else {
$settings->{list_owner_email} =
lc_email( $settings->{list_owner_email} );
my $new_info = {};
my @init_settings = (
qw(
list
list_owner_email
list_name
password
info
physical_address
privacy_policy
consent
)
);
for (@init_settings) {
if ( length( $settings->{$_} ) > 1 ) {
$new_info->{$_} = $settings->{$_};
}
}
require DADA::MailingList;
my $ls;
if ( exists( $options->{clone_settings_from_list} ) ) {
warn 'yes.';
warn
'check_if_list_exists(-List => $options->{clone_settings_from_list}: '
. check_if_list_exists(
-List => $options->{clone_settings_from_list} );
if (
check_if_list_exists(
-List => $options->{clone_settings_from_list}
) <= 0
)
{
warn 'yes.';
$status = 0;
$errors = { clone_list_no_exists => 1 };
return {
status => $status,
errors => {
clone_list_no_exists => 1,
}
};
}
else {
warn 'yes.';
$ls = DADA::MailingList::Create(
{
-list => $settings->{list},
-settings => $new_info,
-clone => xss_filter(
scalar $options->{clone_settings_from_list}
),
}
);
}
}
else {
warn 'yes.';
$ls = DADA::MailingList::Create(
{
-list => $settings->{list},
-settings => $new_info,
}
);
}
if ( $DADA::Config::LOG{list_lives} ) {
require DADA::Logging::Usage;
my $log = new DADA::Logging::Usage;
$log->mj_log(
$settings->{list},
'List Created',
"remote_host:$ENV{REMOTE_HOST},"
. "ip_address:$ENV{REMOTE_ADDR}"
);
}
if ( $options->{'send_new_list_welcome_email'} == 1 ) {
try {
require DADA::App::Messages;
my $dap = DADA::App::Messages->new(
{
-list => $settings->{list},
}
);
# seems dumb to be passing this around, if we don't need to:
my $send_new_list_created_notification_vars = {};
if ( $options->{send_new_list_welcome_email_with_list_pass} ==
1 )
{
$send_new_list_created_notification_vars = {
send_new_list_welcome_email_with_list_pass => 1,
list_password => $settings->{password},
};
}
else {
$send_new_list_created_notification_vars = {
send_new_list_welcome_email_with_list_pass => 0,
list_password => undef,
};
}
$dap->send_new_list_created_notification(
{
-vars => $send_new_list_created_notification_vars
}
);
}
catch {
warn 'problems sending send_new_list_created_notification: '
. $_;
};
}
use Data::Dumper;
return {
status => 1,
results => {
settings => Dumper($settings),
}
};
}
}
sub check_request { sub check_request {
my $self = shift; my $self = shift;
my $status = 1; my $status = 1;
my $errors = {}; my $errors = {};
if ( $self->check_nonce() == 0 ) { if ( $self->check_nonce() == 0 ) {
$status = 0; $status = 0;
$errors->{invalid_nonce} = 1; $errors->{invalid_nonce} = 1;
} }
if ( $self->check_public_key() == 0 ) { if ( $self->check_public_key() == 0 ) {
$status = 0; $status = 0;
$errors->{invalid_public_key} = 1; $errors->{invalid_public_key} = 1;
} }
if ( $self->check_digest() == 0 ) { if ( $self->check_digest() == 0 ) {
$status = 0; $status = 0;
$errors->{invalid_digest} = 1; $errors->{invalid_digest} = 1;
} }
warn '$self->check_list(): ' . $self->check_list();
if ( $self->check_list() == 0 ) { if ( $self->check_list() == 0 ) {
$status = 0;
$errors->{invalid_list} = 1;
}
warn '$self->global_level: ' . $self->global_level;
warn '$self->r_list: ' . $self->r_list;
warn '$self->r_service: ' . $self->r_service;
if ( $self->global_level == 1
&& $self->r_list eq undef
&& $self->r_service eq 'create_new_list' )
{
# Special Case - this is fine.
}
else {
warn 'nope.';
$status = 0;
$errors->{invalid_list} = 1;
}
}
if ($t) { if ($t) {
require Data::Dumper; require Data::Dumper;
warn 'check_request: ' . Data::Dumper::Dumper( { status => $status, erro warn 'check_request: '
rs => $errors } ); . Data::Dumper::Dumper( { status => $status, errors => $errors } );
} }
return ( $status, $errors ); return ( $status, $errors );
} }
sub check_nonce { sub check_nonce {
my $self = shift; my $self = shift;
my ( $timestamp, $nonce ) = split( ':', $self->{cgi_obj}->param('nonce'));
warn '$self->r_cgi_obj->param(\'nonce\'): '
. $self->r_cgi_obj->param('nonce');
my ( $timestamp, $nonce ) = split( ':', $self->r_cgi_obj->param('nonce') );
my $r = 0; my $r = 0;
# for now, we throw away $nonce, but we should probably save it for x amount of time # for now, we throw away $nonce, but we should probably save it for x amount of time
if ( ( int($timestamp) + ( 60 * 5 ) ) < int(time) ) { if ( ( int($timestamp) + ( 60 * 5 ) ) < int(time) ) {
$r = 0; $r = 0;
} }
else { else {
$r = 1; $r = 1;
} }
warn 'check_nonce: ' . $r warn 'check_nonce: ' . $r
if $t; if $t;
return $r; return $r;
} }
sub check_public_key { sub check_public_key {
my $self = shift; my $self = shift;
my $r = 0; my $r = 0;
if ( # I mean, ok:
$self->{ls}->param('public_api_key') # $self->r_public_key
ne $self->{public_key} # is what's passed in the request, so I guess this sort of makes sense:
) { #
warn '$self->global_level : ' . $self->global_level;
my $tmp_public_key = undef;
if ( $self->global_level == 1 ) {
$tmp_public_key = $DADA::Config::GLOBAL_API_OPTIONS->{public_key};
}
else {
$tmp_public_key = $self->ls_obj->param('public_api_key');
}
if ( $tmp_public_key ne $self->r_public_key ) {
$r = 0; $r = 0;
} }
else { else {
$r = 1; $r = 1;
} }
warn 'check_public_key ' . $r warn 'check_public_key ' . $r
if $t; if $t;
return $r; return $r;
} }
sub check_digest { sub check_digest {
my $self = shift; my $self = shift;
my $r = 0; my $r = 0;
my $qq = CGI->new(); my $qq = CGI->new();
$qq->delete_all(); $qq->delete_all();
my $n_digest = undef; my $n_digest = undef;
if ( $self->{service} eq 'mass_email' ) { warn '$self->r_service: ' . $self->r_service
$qq->param( 'format', $self->{cgi_obj}->param('format') ); if $t;
$qq->param( 'message', $self->{cgi_obj}->param('message') );
$qq->param( 'nonce', $self->{cgi_obj}->param('nonce') ); if ( $self->r_service eq 'mass_email' ) {
$qq->param( 'subject', $self->{cgi_obj}->param('subject') ); $qq->param( 'format', $self->r_cgi_obj->param('format') );
$qq->param( 'message', $self->r_cgi_obj->param('message') );
$qq->param( 'nonce', $self->r_cgi_obj->param('nonce') );
$qq->param( 'subject', $self->r_cgi_obj->param('subject') );
# optional # optional
if(defined($self->{cgi_obj}->param('test'))){ if ( defined( $self->r_cgi_obj->param('test') ) ) {
$qq->param( 'test', $self->{cgi_obj}->param('test') ); $qq->param( 'test', $self->r_cgi_obj->param('test') );
} }
$n_digest = $self->digest( $qq->query_string() ); $n_digest = $self->digest( $qq->query_string() );
} }
elsif ( $self->{service} eq 'update_settings' ) { elsif ( $self->r_service eq 'update_settings' ) {
$qq->param( 'nonce', $self->{cgi_obj}->param('nonce') ); $qq->param( 'nonce', $self->r_cgi_obj->param('nonce') );
$qq->param( 'settings', $self->{cgi_obj}->param('settings') ); $qq->param( 'settings', $self->r_cgi_obj->param('settings') );
$n_digest = $self->digest( $qq->query_string() ); $n_digest = $self->digest( $qq->query_string() );
} }
elsif($self->{service} eq 'settings' ){ elsif ( $self->r_service eq 'settings' ) {
$n_digest = $self->digest($self->{cgi_obj}->param('nonce')); $n_digest = $self->digest( $self->r_cgi_obj->param('nonce') );
}
} elsif ( $self->r_service eq 'update_profile_fields' ) {
elsif ( $self->{service} eq 'update_profile_fields' ) { $qq->param( 'email', $self->r_cgi_obj->param('email') );
$qq->param( 'email', $self->{cgi_obj}->param('email') ); $qq->param( 'nonce', $self->r_cgi_obj->param('nonce') );
$qq->param( 'nonce', $self->{cgi_obj}->param('nonce') ); $qq->param( 'profile_fields',
$qq->param( 'profile_fields', $self->{cgi_obj}->param('profile_fields') $self->r_cgi_obj->param('profile_fields') );
);
$n_digest = $self->digest( $qq->query_string() ); $n_digest = $self->digest( $qq->query_string() );
}else { }
$qq->param( 'addresses', $self->{cgi_obj}->param('addresses') ); elsif ( $self->r_service eq 'create_new_list' ) {
$qq->param( 'nonce', $self->{cgi_obj}->param('nonce') ); $qq->param( 'nonce', $self->r_cgi_obj->param('nonce') );
if ( defined( $self->r_cgi_obj->param('options') ) ) {
$qq->param( 'options', $self->r_cgi_obj->param('options') );
}
$qq->param( 'settings', $self->r_cgi_obj->param('settings') );
$n_digest = $self->digest( $qq->query_string() ); $n_digest = $self->digest( $qq->query_string() );
} }
else {
# This should be explicit
$qq->param( 'addresses', $self->r_cgi_obj->param('addresses') );
$qq->param( 'nonce', $self->r_cgi_obj->param('nonce') );
$n_digest = $self->digest( $qq->query_string() );
}
# debug'n # debug'n
$calculated_digest = $n_digest; $calculated_digest = $n_digest;
if ( $self->{digest} ne $n_digest ) { if ( $self->r_digest ne $n_digest ) {
return 0; return 0;
} }
else { else {
return 1; return 1;
} }
} }
sub digest { sub digest {
my $self = shift; my $self = shift;
my $message = shift; my $message = shift;
warn '$message ' . $message warn '$message ' . $message
if $t; if $t;
warn '$self->i_private_api_key: ' . $self->i_private_api_key
if $t;
my $n_digest = hmac_sha256_base64( $message, $self->{ls}->param('private_api _key') ); my $n_digest = hmac_sha256_base64( $message, $self->i_private_api_key );
while ( length($n_digest) % 4 ) { while ( length($n_digest) % 4 ) {
$n_digest .= '='; $n_digest .= '=';
} }
warn '$n_digest:' . $n_digest warn '$n_digest:' . $n_digest
if $t; if $t;
return $n_digest; return $n_digest;
} }
sub check_list { sub check_list {
my $self = shift; my $self = shift;
if ( DADA::App::Guts::list_exists( -List => $self->{list} ) ) { if ( DADA::App::Guts::list_exists( -List => $self->r_list ) ) {
return 1; return 1;
} }
else { else {
return 0; return 0;
} }
} }
sub _massaged_key { sub _massaged_key {
my $self = shift; my $self = shift;
my $key = shift; my $key = shift;
$key =~ s/^\<|\>$//g $key =~ s/^\<|\>$//g
if $key; if $key;
$key =~ s/^\%3C|\%3E$//g $key =~ s/^\%3C|\%3E$//g
if $key; if $key;
$key =~ s/^\&lt\;|\&gt\;$//g $key =~ s/^\&lt\;|\&gt\;$//g
if $key; if $key;
$key =~ s/\.(.*)// $key =~ s/\.(.*)//
if $key; #greedy if $key; #greedy
return $key; return $key;
} }
1; 1;
 End of changes. 86 change blocks. 
223 lines changed or deleted 601 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)