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