line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: Hostname.pm,v 1.3 2003/04/08 00:27:30 cwest Exp $ |
2
|
|
|
|
|
|
|
package POEST::Plugin::Check::Hostname; |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=pod |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
POEST::Plugin::Check::Hostname - Check for a proper host in HELO. |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 ABSTRACT |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Check for a proper host in the HELO command sent from the client. |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 DESCRIPTION |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
1385
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
48
|
|
19
|
|
|
|
|
|
|
$^W = 1; |
20
|
|
|
|
|
|
|
|
21
|
1
|
|
|
1
|
|
7
|
use vars qw[$VERSION @ISA]; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
62
|
|
22
|
|
|
|
|
|
|
$VERSION = (qw$Revision: 1.3 $)[1]; |
23
|
|
|
|
|
|
|
|
24
|
1
|
|
|
1
|
|
47
|
use POEST::Plugin; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
@ISA = qw[POEST::Plugin]; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head2 Events |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head3 HELO |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
Intercept the HELO event. If configured to require a hostname in the |
32
|
|
|
|
|
|
|
HELO sent by the client, it will check the acceptible hosts list for |
33
|
|
|
|
|
|
|
the host specified. If said host is in the list, execution will |
34
|
|
|
|
|
|
|
continue on to the standard HELO implementation that greets the client. |
35
|
|
|
|
|
|
|
If it fails, an error will be sent to the client. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head3 ELOH |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
Same as C. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=cut |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub EVENTS () { [ qw[ HELO ELOH] ] } |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head2 Configuration |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head3 requirehost |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
If true, a specified (and correct) host will be required. Otherwise |
50
|
|
|
|
|
|
|
these checks will be bypassed. Kind of useless without this, isn't |
51
|
|
|
|
|
|
|
it? |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head3 allowedhost |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
This option has multiple values. A list of hosts that are allowed for |
56
|
|
|
|
|
|
|
this SMTP server. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=cut |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub CONFIG () { [ qw[ requirehost allowedhost ] ] } |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
*HELO = *ELOH = sub { |
63
|
|
|
|
|
|
|
my ($kernel, $heap, $self, $session, $cmd, $host) |
64
|
|
|
|
|
|
|
= @_[KERNEL, HEAP, OBJECT, SESSION, ARG0, ARG1]; |
65
|
|
|
|
|
|
|
my $client = $heap->{client}; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
if ( $self->{requirehost} ) { |
68
|
|
|
|
|
|
|
my (@hosts) = ref $self->{allowedhost} ? |
69
|
|
|
|
|
|
|
@{ $self->{allowedhost} } : $self->{allowedhost}; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
unless ( $host && grep { $host eq $_ } @hosts ) { |
72
|
|
|
|
|
|
|
$client->put( SMTP_ARG_SYNTAX_ERROR, qq[Syntax: $cmd hostname] ); |
73
|
|
|
|
|
|
|
$session->stop; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
}; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
1; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
__END__ |