File Coverage

lib/Mail/Toaster/Ezmlm.pm
Criterion Covered Total %
statement 39 232 16.8
branch 0 96 0.0
condition 0 26 0.0
subroutine 13 22 59.0
pod 8 9 88.8
total 60 385 15.5


line stmt bran cond sub pod time code
1 1     1   674 use strict;
  1         2  
  1         24  
2 1     1   3 use warnings;
  1         1  
  1         37  
3              
4             our $VERSION = '5.50';
5              
6             package Mail::Toaster::Ezmlm;
7              
8 1     1   4 use Params::Validate ':all';
  1         1  
  1         113  
9 1     1   443 use Pod::Usage;
  1         31502  
  1         117  
10 1     1   8 use English qw( -no_match_vars );
  1         1  
  1         8  
11              
12 1     1   285 use lib 'lib';
  1         2  
  1         6  
13 1     1   97 use parent 'Mail::Toaster::Base';
  1         2  
  1         6  
14              
15             sub authenticate {
16 0     0 1   my $self = shift;
17 0           my %p = validate ( @_, {
18             'domain' => SCALAR,
19             'password' => SCALAR,
20             $self->get_std_opts,
21             },
22             );
23              
24 0           my ($domain, $password ) = ( $p{domain}, $p{password} );
25 0           my %args = $self->get_std_args( %p );
26              
27 0 0         return $p{test_ok} if defined $p{test_ok};
28              
29 0           $self->util->install_module( "vpopmail", %args );
30              
31 0           require vpopmail;
32              
33 0 0         if ( vpopmail::vauth_user( 'postmaster', $domain, $password, undef ) ) {
34 0           $self->audit( "authenticated postmaster\@$domain (ok)", %args);
35 0           return 1;
36             }
37              
38 0           print "AUTHENTICATION FAILED! (dom: $domain, pass: $password)<br>";
39              
40 0           print "if you are certain the authentication information is correct, then
41             it is quite likely you cannot authenticate because your web server is running as
42             a user ($UID) that lacks permission to run this script. You can:<br>
43             <br>
44             <blockquote>
45             a: run this script suid vpopmail<br>
46             b: run the web server as user vpopmail<br>
47             c: use suEXEC
48             </blockquote>
49             <br>
50             \n\n";
51              
52 0           return 0;
53             }
54              
55             sub dir_check {
56 0     0 1   my $self = shift;
57 0           my %p = validate( @_, {
58             'dir' => SCALAR,
59             'br' => { type=>SCALAR, optional=>1, default=>'<br>' },
60             $self->get_std_opts,
61             },
62             );
63              
64             my ( $dir, $br, $fatal, $verbose )
65 0           = ( $p{'dir'}, $p{'br'}, $p{'fatal'}, $p{'verbose'} );
66              
67 0 0 0       unless ( -d $dir && -r $dir ) {
68 0           $self->error( "no read perms to $dir: $! $br",fatal=>0);
69 0           return 0;
70             };
71              
72 0           $self->audit( "dir_check: checking: $dir" );
73 0           return 1;
74             }
75              
76             sub footer {
77 0     0 0   shift; # $self
78 0           print <<EOFOOTER;
79             <hr> <p align="center"><font size="-2">
80             <a href="http://mail-toaster.org">Mail::Toaster::Ezmlm</a>
81             $Mail::Toaster::VERSION -
82             &copy; <a href="http://www.tnpi.net">The Network People, Inc.</a> 1999-2010 <br><br>
83             </font>
84             </p>
85             </body>
86             </html>
87             EOFOOTER
88              
89             }
90              
91             sub lists_get {
92 0     0 1   my $self = shift;
93 0           my %p = validate( @_, {
94             'domain' => { type=>SCALAR, },
95             'br' => { type=>SCALAR, optional=>1, default=>'<br>' },
96             $self->get_std_opts,
97             },
98             );
99              
100             my ( $domain, $br, $fatal, $verbose )
101 0           = ( $p{'domain'}, $p{'br'}, $p{'fatal'}, $p{'verbose'} );
102              
103 0           my %lists;
104              
105 0           $self->util->install_module( "vpopmail", verbose => $verbose,);
106              
107 0           require vpopmail;
108              
109 0           my $dir = vpopmail::vgetdomaindir($domain);
110              
111 0 0         unless ( -d $dir ) {
112 0           print
113             "FAILED: invalid directory ($dir) returned from vgetdomaindir $br";
114 0           return 0;
115             }
116              
117 0 0         print "domain dir for $domain: $dir $br" if $verbose;
118              
119 0 0         print "now fetching a list of ezmlm lists..." if $verbose;
120              
121 0           foreach my $all ( $self->util->get_dir_files( $dir ) ) {
122 0 0         next unless ( -d $all );
123              
124 0           foreach my $second ( $self->util->get_dir_files( $all ) ) {
125 0 0         next unless ( -d $second );
126 0 0         if ( $second =~ /subscribers$/ ) {
127 0 0         print "found one: $all, $second $br" if $verbose;
128 0           my ( $list_dir, $path ) = fileparse($all); chop $path;
  0            
129 0 0         print "list name: $list_dir $br" if $verbose;
130 0           $lists{$list_dir} = $all;
131             }
132             else {
133 0 0         print "failed second match: $second $br" if $verbose;
134             }
135             }
136             }
137              
138 0 0         print "done. $br" if $verbose;
139              
140 0           return \%lists;
141             }
142              
143             sub logo {
144 0     0 1   my $self = shift;
145 0           my %p = validate( @_, {
146             'conf' => { type=>HASHREF, optional=>1, },
147             'web_logo_url' => { type=>SCALAR, optional=>1, },
148             'web_logo_alt' => { type=>SCALAR, optional=>1, },
149             $self->get_std_opts,
150             },
151             );
152              
153 0           my $conf = $p{'conf'};
154 0 0         return $p{test_ok} if defined $p{test_ok};
155              
156 0 0         my $logo = $conf->{'web_logo_url'} or return '';
157 0   0       my $alt = $conf->{'web_logo_alt'} || '';
158              
159 0           return "<img src=\"$logo\" alt=\"$alt\">";
160             }
161              
162             sub process_cgi {
163 0     0 1   my $self = shift;
164              
165 0           my %p = validate( @_, {
166             'list_dir' => { type=>SCALAR, optional=>1, },
167             'br' => { type=>SCALAR, optional=>1, default=>'<br>' },
168             $self->get_std_opts,
169             },
170             );
171              
172             my ( $list_dir, $br, $fatal, $verbose )
173 0           = ( $p{'list_dir'}, $p{'br'}, $p{'fatal'}, $p{'verbose'} );
174              
175 0           my ( $mess, $ezlists, $authed );
176              
177 1     1   1508 use CGI qw(:standard);
  1         20526  
  1         6  
178 1     1   2334 use CGI::Carp qw( fatalsToBrowser );
  1         1789  
  1         5  
179 0           print header('text/html');
180              
181 0           $self->util->install_module( "HTML::Template", verbose => $verbose,);
182              
183 0           my $conf = $self->util->parse_config( "toaster.conf", verbose => 0 );
184              
185 0           $verbose = 0;
186              
187 0           my $cgi = CGI->new;
188              
189             # get settings from HTML form submission
190 0   0       my $domain = param('domain') || '';
191 0   0       my $password = param('password') || '';
192 0           my $list_sel = param('list');
193 0           my $action = param('action');
194              
195 0 0         unless ($list_sel) { $mess .= " select a list from the menu" }
  0            
196 0 0         unless ($action) { $mess .= " select an action.<br>" }
  0            
197              
198             # display create the HTML form
199 0           my $template = HTML::Template->new( filename => 'ezmlm.tmpl' );
200              
201 0           $template->param( logo => $self->logo(conf=>$conf) );
202 0           $template->param( head => 'Ezmlm Mailing List Import Tool' );
203 0           $template->param(
204             domain => '<input name="domain" type="text" value="' . $domain
205             . '" size="20">' );
206 0           $template->param(
207             password => '<input name="password" type="password" value="'
208             . $password
209             . '" size="20">' );
210 0           $template->param( action =>
211             '<input name="action" type="radio" value="list"> List <input name="action" type="radio" value="add">Add <input name="action" type="radio" value="remove"> Remove'
212             );
213              
214 0           my $list_of_lists = '<select name="list">';
215              
216 0 0 0       if ( $domain && $password ) {
217 0 0         print "we got a domain ($domain) & password ($password)<br>" if $verbose;
218              
219 0           $authed = $self->authenticate( domain=>$domain, password=>$password, verbose=>$verbose );
220              
221 0 0         if ($authed) {
222 0           $ezlists = $self->lists_get( domain=>$domain, br=>$br, verbose=>$verbose );
223 0 0         print "WARNING: couldn't retrieve list of ezmlm lists!<br>"
224             unless $ezlists;
225              
226 0           foreach my $key ( keys %$ezlists ) {
227 0 0         $list_of_lists .=
228             '<option value="' . $key . '">' . $key . '</option>'
229             if $key;
230             }
231             }
232             }
233 0           else { $mess = "authentication information is missing!<br>"; }
234              
235 0           $list_of_lists .= '</select>';
236              
237 0           $template->param( instruct => $mess );
238 0           $template->param( list => $list_of_lists );
239              
240 0           print $template->output;
241              
242 0 0 0       if ( $action && $list_sel ) {
243 0 0         unless ($authed) {
244 0           print "skipping processing because authentication failed!<br>";
245 0           exit 0;
246             }
247              
248 0           $self->util->install_module( "vpopmail", verbose => $verbose,);
249 0 0         print "running vpopmail v", vpopmail::vgetversion(), "<br>" if $verbose;
250              
251 0           $self->util->install_module( "Mail::Ezmlm", verbose => $verbose,);
252 0           require Mail::Ezmlm;
253              
254 0           $list_dir = $ezlists->{$list_sel};
255 0 0         return 0 unless $self->dir_check( dir=>$list_dir, br=>$br, verbose=>$verbose );
256 0           my $list = new Mail::Ezmlm($list_dir);
257              
258 0 0         if ( $action eq "list" ) {
    0          
259 0           $self->subs_list( list=>$list, list_dir=>$list_dir, br=>$br, verbose=>$verbose );
260             }
261             elsif ( $action eq "add" ) {
262 0           my @reqs = split( /\n/, param('addresses') );
263 0 0         print "reqs: @reqs<br>" if $verbose;
264 0           my $requested = \@reqs;
265 0           $self->subs_add( list=>$list, list_dir=>$list_dir, requested=>$requested, br=>$br );
266             }
267             else {
268 0           print "Sorry, action $action is not supported yet.<br>";
269             }
270             }
271             else {
272 0           print "missing auth, action, or lists<br>";
273             }
274              
275 0           $self->footer();
276             }
277              
278             sub process_shell {
279 0     0 1   my $self = shift;
280 0           my %p = validate( @_, { $self->get_std_opts } );
281 1     1   485 use vars qw($opt_a $opt_d $opt_f $opt_v $list );
  1         1  
  1         92  
282 0           my $verbose = $p{verbose};
283              
284 0           $self->util->install_module( "Mail::Ezmlm", %p );
285 0           require Mail::Ezmlm;
286              
287 1     1   1452 use Getopt::Std;
  1         26  
  1         398  
288 0           getopts('a:d:f:v');
289              
290 0           my $br = "\n";
291 0 0         $verbose = $opt_v if defined $opt_v;
292              
293             # set up based on command line options
294 0           my $list_dir;
295 0 0         $list_dir = $opt_d if $opt_d;
296              
297 0 0         return $p{test_ok} if defined $p{test_ok};
298              
299             # set a default list dir if not already set
300 0 0         if (! $list_dir) {
301 0           print "You didn't set the list directory! Use the -d option!\n";
302 0           pod2usage;
303             }
304 0 0         return 0 if ! $self->dir_check( dir=>$list_dir, br=>$br, verbose=>$verbose );
305              
306 0 0 0       if ( $opt_a && $opt_a eq "list" ) {
307 0           $list = new Mail::Ezmlm($list_dir);
308 0           $self->subs_list( list=>$list, list_dir=>$list_dir, br=>$br, verbose=>$verbose );
309 0           return 1;
310             }
311              
312 0 0 0       unless ( $opt_a && $opt_a eq "add" ) {
313 0           pod2usage();
314 0           return 0;
315             }
316              
317             # since we're adding, fetch a list of email addresses
318 0           my $requested;
319 0           my $list_file = $opt_f;
320 0   0       $list_file ||= "ezmlm.importme";
321              
322 0 0         unless ( -e $list_file ) {
323 0           print "FAILED: cannot find $list_file!\n Try specifying it with -f.\n";
324 0           return 0;
325             }
326              
327 0 0         if ( -r $list_file ) {
328 0           my @lines = $self->util->file_read($list_file, verbose=>$verbose);
329 0           $requested = \@lines;
330             }
331             else {
332 0           print "FAILED: $list_file not readable!\n";
333 0           return 0;
334             }
335              
336 0           $list = new Mail::Ezmlm($list_dir);
337              
338             #$list->setlist($list_dir); # use this to switch lists
339              
340 0           $self->subs_add( list=>$list, list_dir=>$list_dir, requested=>$requested, br=>$br );
341              
342 0           return 1;
343             }
344              
345             sub subs_add {
346 0     0 1   my $self = shift;
347 0           my %p = validate( @_, {
348             'list' => { type=>SCALAR, },
349             'list_dir' => { type=>SCALAR, },
350             'requested' => { type=>ARRAYREF, },
351             'br' => { type=>SCALAR, },
352             $self->get_std_opts,
353             },
354             );
355              
356             my ($list, $list_dir, $requested, $br, $fatal, $verbose)
357 0           = ( $p{'list'}, $p{'list_dir'}, $p{'requested'}, $p{'br'}, $p{'fatal'}, $p{'verbose'} );
358            
359 0 0         if ( ! -d $list_dir ) {
360 0 0         print "ERROR: Aiiieee, the list $list_dir is missing!\n" if $verbose;
361 0           return 0;
362             }
363              
364 0           my ( $duplicates, $success, $failed, @list_dups, @list_success, @list_fail );
365              
366 0           print "$br";
367              
368 0 0 0       unless ( $requested && $requested->[0] ) {
369 0           print "FAILURE: no list of addresses was supplied! $br";
370 0           exit 0;
371             }
372              
373 0           foreach my $addy (@$requested) {
374 0           $addy = lc($addy); # convert it to lower case
375 0           chomp($addy);
376 0           ($addy) = $addy =~ /([a-z0-9\.\-\@]*)/;
377              
378 0           printf "adding %25s...", $addy;
379              
380 1     1   4 no warnings;
  1         2  
  1         72  
381 0           require Email::Valid;
382 0 0         unless ( Email::Valid->address($addy) ) {
383 0           print "FAILED! (address fails $Email::Valid::Details check). $br";
384 0           $failed++;
385 0           next;
386             }
387 1     1   3 use warnings;
  1         1  
  1         258  
388              
389 0 0         if ( $list->issub($addy) ) {
390 0           $duplicates++;
391 0           push @list_dups, $addy;
392 0           print "FAILED (duplicate). $br";
393             }
394             else {
395 0 0         if ( $list->sub($addy) ) {
396 0           print "ok. $br";
397 0           $success++;
398             }
399             else {
400 0           print "FAILED! $br";
401 0           $failed++;
402             }
403             }
404             }
405              
406 0           print " $br $br --- STATISTICS --- $br $br";
407 0           printf "duplicates...%5d $br", $duplicates;
408 0           printf "success......%5d $br", $success;
409 0           printf "failed.......%5d $br", $failed;
410             }
411              
412             sub subs_list {
413 0     0 1   my $self = shift;
414 0           my %p = validate( @_, {
415             'list' => { type=>HASHREF, },
416             'list_dir' => { type=>SCALAR, },
417             'br' => { type=>SCALAR, optional=>1, default=>'\n' },
418             $self->get_std_opts,
419             },
420             );
421              
422             my ( $list, $list_dir, $br, $fatal, $verbose )
423 0           = ( $p{'list'}, $p{'list_dir'}, $p{'br'}, $p{'fatal'}, $p{'verbose'} );
424              
425 0 0         if ( ! -d $list_dir ) {
426 0 0         print "ERROR: Aiiieee, the list $list_dir is missing!\n" if $verbose;
427 0           return 0;
428             }
429 0 0         print "subs_list: listing subs for list $list_dir $br" if $verbose;
430              
431             # print "subscriber list: ";
432             # $list->list; # list subscribers
433             # #$list->list(\*STDERR); # list subscribers
434             # "\n";
435              
436 0 0         print "subs_list: getting list of subscribers...$br$br" if $verbose;
437              
438 0           foreach my $sub ( $list->subscribers ) {
439 0           print "$sub $br";
440             }
441              
442 0           print "$br done. $br";
443             }
444              
445              
446             1;
447             __END__
448              
449              
450             =head1 NAME
451              
452             Mail::Toaster::Ezmlm - a batch processing tool for ezmlm mailing lists
453              
454             =head1 SYNOPSIS
455              
456             ezmlm.cgi -a [ add | remove | list ]
457              
458             -a action - add, remove, list
459             -d dir - ezmlm list directory
460             -f file - file containing list of email addresses
461             -v verbose - print verbose options
462              
463              
464             =head1 DESCRIPTION
465              
466             Ezmlm.cgi is a command line and CGI application that allows a domain administrator (ie, postmaster@example.com) to add, remove, and list batches of email addresses. You can use this utility to subscribe lists of email addresses, delete a list of addresses, or simply retrieve a list of subscribers.
467              
468              
469             =head1 DEPENDENCIES
470              
471             some functions depend on Mail::Ezmlm;
472             authentication depends on "vpopmail" (a perl extension)
473              
474             If you need to run ezmlm.cgi suid, which is likely the case, then hacks to Mail::Ezmlm are required for the "list" function to work in taint mode. Also, for a perl script to run suid, you must have suidperl installed. Another (better) approach is to use Apache suexec instead of suidperl.
475              
476              
477             =head1 METHODS
478              
479             =over
480              
481             =item new
482              
483             Creates a new Mail::Toaster::Ezmlm object.
484              
485             use Mail::Toaster::Ezmlm;
486             my $ez = Mail::Toaster::Ezmlm;
487              
488              
489             =item authenticate
490              
491             Authenticates a HTTP user against vpopmail to verify the user has permission to do what they're asking.
492              
493              
494             =item dir_check
495              
496             Check a directory and see if it's a directory and readable.
497              
498             $ezmlm->dir_check(dir=>$dir);
499              
500             return 0 if not, return 1 if OK.
501              
502              
503             =item lists_get
504              
505             Get a list of Ezmlm lists for a given mail directory. This is designed to work with vpopmail where all the list for example.com are in ~vpopmail/domains.
506              
507             $ezmlm->lists_get("example.com");
508              
509              
510             =item logo
511              
512             Put the logo on the HTML page. Sets the URL from $conf.
513              
514             $ezmlm->logo(conf=>$conf);
515              
516             $conf is values from toaster.conf.
517              
518             Example:
519             $ezmlm->logo(
520             web_logo_url => 'http://www.tnpi.net/images/head.jpg',
521             web_log_alt => 'tnpi.net logo',
522             );
523              
524              
525             =item process_cgi
526              
527             Accepts input from HTTP requests, presents a HTML request form, and triggers actions based on input.
528              
529             $ez->process_cgi();
530              
531              
532             =item process_shell
533              
534             Get input from the command line options and proceed accordingly.
535              
536              
537             =item subs_add
538              
539             Subcribe a user (or list of users) to a mailing list.
540              
541             $ezmlm->subs_add(
542             list => $list_name,
543             list_dir => $list_dir,
544             requested => $address_list
545             );
546              
547              
548             =item subs_list
549              
550             Print out a list of subscribers to an Ezmlm mailing list.
551              
552             $ezmlm->subs_list(list=>$list, dir=>$list_dir);
553              
554              
555             =back
556              
557             =head1 AUTHOR
558              
559             Matt Simerson (matt@tnpi.net)
560              
561              
562             =head1 BUGS
563              
564             None known. Report any to author.
565              
566              
567             =head1 TODO
568              
569             =head1 SEE ALSO
570              
571             The following are all man/perldoc pages:
572              
573             Mail::Toaster
574             Mail::Toaster::Conf
575             toaster.conf
576             toaster-watcher.conf
577              
578             http://mail-toaster.org/
579              
580              
581             =head1 COPYRIGHT AND LICENSE
582              
583             Copyright (c) 2005-2012, The Network People, Inc. All rights reserved.
584              
585             Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
586              
587             Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
588              
589             Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
590              
591             Neither the name of the The Network People, Inc. nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
592              
593             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
594              
595              
596             =cut
597