This file is indexed.

/usr/share/perl5/Mail/Bulkmail/DummyServer.pm is in libmail-bulkmail-perl 3.12-5.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
package Mail::Bulkmail::DummyServer;

# Copyright and (c) 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved.
# Mail::Bulkmail::DummyServer is distributed under the terms of the Perl Artistic License.

=pod

=head1 NAME

Mail::Bulkmail::DummyServer - dummy class for dummy server objects

=head1 AUTHOR

Jim Thomason, jim@jimandkoka.com

=head1 DESCRIPTION

Mail::Bulkmail::DummyServer is a drop in replacement for Mail::Bulkmail::Server.

Sometimes you just want to test things on your end - make sure your list iterates properly, make
sure your mail merge is functioning fine, make sure your logging functions are correct, whatever.
And in those cases, you probably don't want to worry about futzing around with your SMTP relay and
sending junk messages through it that you don't care about. Not to mention the fact that those
probably will need to be inspected and deleted later. A hassle for debugging.

Enter DummyServer. This is a subclass of Mail::Bulkmail::Server that behaves exactly the same
except for the fact that it doesn't actually connect to a server. Instead, it sends all data
that would be going to the server to a file instead. This file should be specified in the conf file.

 #in your conf file
 define package Mail::Bulkmail::DummyServer
 dummy_file	= ./my.dummy.file

Now, instead of sending commands to your SMTP relay, they'll get sent to ./my.dummy.file for easy
inspection at a later date.

=cut

use Mail::Bulkmail::Server;
@ISA = qw(Mail::Bulkmail::Server);

$VERSION = '3.12';

use strict;
use warnings;

=pod

=head1 CLASS ATTRIBUTES

=over 11

=item dummy_file

Stores the dummy_file that you want to output your data to.

=back

=cut

__PACKAGE__->add_attr('dummy_file');

# this is used for tied filehandles to internally hold the dummy socket
__PACKAGE__->add_attr('_socket');

=pod

=head1 METHODS

=over 11

=item connect

"connects" to your DummyServer. Actually, internally it ties a filehandle onto this package.
Yes, this thing has a (minimal) implementation of a tied handle class to accomplish this feat.

This method is known to return

 MBDu001 - server won't say EHLO

=cut

sub connect {
	my $self = shift;

	local $\ = "\015\012";
	local $/ = "\015\012";

	my $h = $self->gen_handle();
	tie *$h, "Mail::Bulkmail::DummyServer", $self;

	$self->socket($h);

	#We're either given a domain, or we'll build it based on who the message is from
	my $domain = $self->Domain;

	print $h "EHLO $domain";

	my $response = <$h> || "";
	return $self->error("Server won't say EHLO: $response", "MBDu001") if ! $response || $response =~ /^[45]/;

	$self->connected(1);
	return $self;
};

# TIEHANDLE, as usual, ties a filehandle onto this class. It reads the file that is defined
# _in_the_conf_file at Mail::Bulkmail::DummyServer->dummy_file, tries to open it (dies with an
# error if it can't), and then ties our filehandle to the just opened file.
sub TIEHANDLE {

	my $class	= shift;
	my $self	= shift;

	my $file = $self->dummy_file();

	my $handle = Mail::Bulkmail::Object->gen_handle();

	open ($handle, ">>$file") || die $!;

	return $class->new('_socket' => $handle);
};

# in case our filehandle is fetched, just display some minimal information, namely the fact
# that we're in DummyServer, and the name of the dummy file
sub FETCH {
	return "DummyServer at file : " . shift->_socket;
};

# prints to our dummy file. Uses sendmail crlfs, and tacks on a note that we're starting
# a new message if we get a RSET command
sub PRINT {

	my $f = shift->_socket;

	local $\ = "\015\012";
	local $/ = "\015\012";

	if ($_[0] eq 'RSET'){
		print $f "--------NEW MESSAGE (connection reset)-------" if $f;
	};

	print $f @_ if $f;

	return 1;
};

sub FILENO {
	my $f = shift->_socket;
	my $n = fileno($f);
};

# We can't read from this file, it's output only. However, we need to return something since
# talk_and_respond is expecting to read information from its SMTP socket

sub READLINE {
	return "250 bullshit all happy-happy" . scalar localtime() . "\015\012";
};

# closes our filehandle

sub CLOSE {
	my $f = shift->_socket;
	close $f if $f;
	return 1;
};

=pod

=item disconnect

overloaded disconnect method. Wipes out the internal socket as usual, but doesn't try
to say RSET or QUIT to the server.

disconnect can also disconnect quietly, i.e., it won't try to issue a RSET and then quit before closing the socket.

 $server->disconnect(); 			#issues RSET and quit
 $server->disconnect('quietly');	#issues nothing

=back

=cut

sub disconnect {
	my $self	= shift;
	my $quietly	= shift;

	return $self unless $self->connected();

	$self->talk_and_respond('RSET') unless $quietly;	#just to be polite
	$self->talk_and_respond('quit') unless $quietly;

	if (my $socket = $self->socket) {
		close $socket;
		$socket = undef;
	};
	$self->socket(undef);
	$self->connected(0);
	return $self;
};

1;

__END__

=pod

=head1 SEE ALSO

Mail::Bulkmail::Server

=head1 COPYRIGHT (again)

Copyright and (c) 2003 James A Thomason III (jim@jimandkoka.com). All rights reserved.
Mail::Bulkmail::DummyServer is distributed under the terms of the Perl Artistic License.

=head1 CONTACT INFO

So you don't have to scroll all the way back to the top, I'm Jim Thomason (jim@jimandkoka.com) and feedback is appreciated.
Bug reports/suggestions/questions/etc.  Hell, drop me a line to let me know that you're using the module and that it's
made your life easier.  :-)

=cut