1package Net::Server::Mail::ESMTP::AUTH;
2
3use 5.006;
4use strict;
5use base qw(Net::Server::Mail::ESMTP::Extension);
6use MIME::Base64;
7
8use vars qw( $VERSION );
9$VERSION = '0.2';
10
11=head1 NAME
12
13Net::Server::Mail::ESMTP::AUTH - SMTP Authentification extensions for Net::Server::Mail::ESMTP
14
15=head1 SYNOPSIS
16
17  use Net::Server::Mail::ESMTP;
18  my @local_domains = qw(example.com example.org);
19  my $server = new IO::Socket::INET Listen => 1, LocalPort => 25;
20
21  my $conn;
22  while($conn = $server->accept)
23  {
24    my $esmtp = new Net::Server::Mail::ESMTP socket => $conn;
25
26    # activate AUTH extension
27    $esmtp->register('Net::Server::Mail::ESMTP::AUTH');
28
29    # adding AUTH handler
30    $esmtp->set_callback(AUTH => \&validate_auth);
31    $esmtp->set_callback(DATA => \&queue_message);
32    $esmtp->process;
33  }
34
35  sub validate_auth
36  {
37    my ($session, $username, $password) = @_;
38
39    if ($username eq 'ROBERT' and $password eq 'TOTO04') {
40      # AUTH SUCCESFULL
41      $session->{AUTH}->{ok} = 1;
42      return 1;
43    } else {
44      # AUTH FAILED
45      return 0;
46    }
47  }
48
49sub queue_message {
50    my($session, $data) = @_;
51
52    # providing AUTH doesn't make it mandatory.
53    # A client might not use AUTH at all!
54    # You must deal now with permissions:
55
56    unless ($session->{AUTH}->{ok}) {
57        # warn "no AUTH supplied!";
58        return(0, 530, 'Error: Authentication required');
59    }
60    ... do stuff
61}
62
63=head1 FEATURES
64
65  * AUTH LOGIN method support
66  * AUTH PLAIN method support
67
68=head1 DESCRIPTION
69
70"Net::Server::Mail::ESMTP::AUTH" is an extension to provide
71ESMTP Authentification support to Net::Server::Mail::ESMTP module.
72Actually only AUTH LOGIN and AUTH PLAIN methods are supported.
73
74AUTH callback is called with login and password who was given
75by user's mail client, AUTH callback should return 1 when authentification
76mechanism was succesfull otherwise 0.
77
78=cut
79
80our $verb = 'AUTH';
81
82sub init
83{
84	my ($self, $parent) = @_;
85	$self->{AUTH} = ();
86
87	return $self;
88}
89
90sub verb
91{
92	return ( [ 'AUTH' => \&process, ],);
93}
94
95sub keyword
96{
97	return 'AUTH LOGIN PLAIN';
98}
99
100sub reply
101{
102	return ( [ 'AUTH', ]);
103}
104
105sub process_authlogin_username
106{
107  my ($self, $operation) = @_;
108	$self->{AUTH}->{username} = decode_base64($operation);
109	$self->{AUTH}->{password} = '';
110	$self->reply(334, "UGFzc3dvcmQ6");
111	$self->next_input_to(\&process_authlogin_password);
112	return ();
113}
114
115sub process_authlogin_password
116{
117	my ($self, $operation) = @_;
118	$self->{AUTH}->{password} = decode_base64($operation);
119
120	return exec_auth_callback($self);
121}
122
123sub exec_auth_callback
124{
125	my ($self) = @_;
126
127	my $authok=0;
128
129	my $ref = $self->{callback}->{AUTH};
130	if (ref $ref eq 'ARRAY' && ref $ref->[0] eq 'CODE') {
131		my $code = $ref->[0];
132
133		$authok = &$code($self, $self->{AUTH}->{username}, $self->{AUTH}->{password});
134	}
135
136	if ($authok) {
137		$self->reply(235, "Authentification successful.");
138		return ();
139	} else {
140 		$self->reply(535, "Authentification failed.");
141		return 1;
142	}
143}
144
145sub process
146{
147	my ($self, $data) = @_;
148	my ($operation, $param) = $data=~/^(.+?)\s(.*)$/ ? ($1, $2) : ($data, '');
149
150	$self->{AUTH}->{type} = $operation;
151	map { $self->{AUTH}->{$_} = '' } ('username', 'password', 'challenge', 'ticket', );
152
153	if ($operation eq '*') {
154 	  $self->reply(501, "Authentification aborted.");
155		return ();
156	} elsif ($operation eq 'PLAIN') {
157		$param=decode_base64($param);
158		my @plaindata = split /\0/, $param;
159		unless (@plaindata > 2) {
160  		$self->reply(535, "Authentification failed.");
161			return ();
162		} else {
163			$self->{AUTH}->{username} = $plaindata[@plaindata-2];
164			$self->{AUTH}->{password} = $plaindata[@plaindata-1];
165			return exec_auth_callback($self);
166		}
167	} elsif ($operation eq 'LOGIN') {
168		$param=decode_base64($param);
169		# warn " ==> LOGIN ==> $param\n";
170		$self->reply(334, "VXNlcm5hbWU6");
171		$self->next_input_to(\&process_authlogin_username);
172		return ();
173	} else {
174		$self->reply(504, "Unrecognized authentification type.");
175  }
176
177	return ();
178}
179
180=pod
181
182=head1 SEE ALSO
183
184Please, see L<Net::Server::Mail::SMTP> and L<Net::Server::Mail::ESMTP> for
185more documentations.
186
187=head1 AUTHOR
188
189Sylvain Cresto E<lt>scresto@gmail.comE<gt>
190
191Thanks to Chris E<lt>chris at u- club.deE<gt>
192
193=head1 BUGS
194
195Please send bug-reports to scresto@gmail.com.
196
197=head1 LICENCE
198
199This library is free software; you can redistribute it and/or modify
200it under the same terms as Perl itself.
201
202=head1 COPYRIGHT
203
204Copyright (C) 2004, 2016 - Sylvain Cresto
205
206=cut
207
2081;
209