File Coverage

blib/lib/SMS/Handler/Email.pm

Criterion	Covered	Total	%
statement	66	764	8.6
branch	0	290	0.0
condition	0	113	0.0
subroutine	22	69	31.8
pod	6	10	60.0
total	94	1246	7.5

package SMS::Handler::Email;

require 5.005_62;

use Carp;
use strict;
use warnings;
use IO::File;
use Net::SMTP;
use Net::POP3;
use Mail::Audit;
use Date::Parse;
use Digest::MD5;
use SMS::Handler;
use MIME::Parser;
use Text::Abbrev;
use HTML::Parser;
use Mail::Address;
use Unicode::Map8;
use Net::SMPP 1.04;
use POSIX qw(strftime);
use Fcntl qw(SEEK_SET);
use SMS::Handler::Utils;
use SMS::Handler::Dispatcher;
use Params::Validate qw(:all);
use MIME::WordDecoder qw(unmime);

# $Id: Email.pm,v 1.55 2003/03/13 20:41:54 lem Exp $

our $VERSION = q$Revision: 1.55 $;
$VERSION =~ s/Revision: //;

our @ISA = qw(SMS::Handler::Dispatcher);

our $Debug = 0;

=pod

=head1 NAME

SMS::Handler::Email - Process Email related commands

=head1 SYNOPSIS

  use SMS::Handler::Email;

  my $h = SMS::Handler::Email->new(-queue => $queue_obj,
				   -state => $ref_to_hash,
				   -secret => $my_secret_phrase,
				   -addr => '9.9.5551212',
				   -pop => 'pop.your.com',
				   -smtp => 'smtp.your.com',
				   -maxlen => 160,
				   -maxfetch => 1024,
				   -compact => 1,
				   -spamcheck => $obj,
				   -cmds => { ... },
    				   -help => { ... },
    				   -maxspam => 10,
				   );

 $h->handle({ ... });

=head1 DESCRIPTION

This module implements a simple responder class. It will respond to
any message directed to the specified phone number, with the specified
message.

The Email message is assumed to be in ISO-8859-1 (Latin1)
encoding. Mappings are provided to convert the messages to a safe
7-Bit character set which is believed to be compatible with any SMS
receiver. This mapping is lossy in the sense that accents and special
characters are converted to a close but incorrect representation. For
instance, an B is converted to a plain B.

=head2 SUPPORTED COMMANDS

The following commands are supported in the first line of the
SMS. Commands can be abbreviated to any unique substring. The first
line can be separated by the rest of the message either with a
new-line or two consecutive space characters.

=over 2

=item B<.ACCOUNT login password>

Associates the given account with the source address of the
SMS. Further commands coming from this address are attempted with
these supplied credentials, which are the login or username and
password of the POP server.

=item B<.CHECK>

Checks all the messages in the mailbox looking for spam. This requires
that a B item be passed to C<-Enew()> at object
creation time. A specially formatted response message, suitable to
remove all the SPAM messages will be returned.

If this command is followed by the B symbol, messages recognized as
SPAM will be erased automatically.

=item B<.SEND to subject>

Sends the remainder of the SMS as a message to the address(es)
specified in the B field. Multiple addresses can be specified by
separating them with commas. No spaces are allowed in the addresses.

Before the actual sending of the message, a POP authentication is
attempted. Only if this authentication succeeds will the message be
sent.

=item B<.LIST>

Retrieves the current list of messages in the POP server.

=item B<.DELETE msg>

Deletes the message B from the POP server. When omitting B,
the command will refer to the most recent message. 0 is a synonim to
1.

=item B<.REPLY msg>

Replies to the message specified by B. When omitting B, the
command will refer to the most recent message. 0 is a synonim to 1.

=item B<.ALL msg>

Replies to the message specified by B. When omitting B, the
command will refer to the most recent message. 0 is a synonim to
1. All recipients of the original message are copied of the response.

=item B<.FORWARD msg to>

Forwards the message specified by B to the addresses specified in
B. When omitting B, the command will refer to the most recent
message. 0 is a synonim to 1.

=item B<.GET msg [block]>

Retrieves the message B from the POP server. Only the first chars
of the body are retrieved. If a numeric block is specified, that block
of octets is presented to the user. The first block is 1. The first
block of the most recent message can be requested by omitting B
and B. B must be specified in order for B to be
specified too. A B 0 is synonim to 1.

=item B<.ALIAS [address] nick>

Creates a nick for the user whose address is specified. If no address
is specified, erases the nick. Nick names or aliases, are used as
shorthand for the complete email address of a user.

=item B<.HELP>

Sends a (very) short usage summary.

=back

The variable C<$SMS::Handler::Email::DefaultLanguage> can be used to
choose the default language of all the answers.

=pod

=head2 HELP TABLE

The help table is a hash stored in C<%SMS::Handler::Email::Help>. Each
key of the hash, is a command name. Each corresponding value is the
reference to a hash, whose key is a language code and its value is a
brief explanation of what the command does in the corresponding
language.

Probably it is wise to avoid explanations that use 8 bit characters,
as those are not safely handled by all the phones out there.

=cut

our %Help =
    (
     ACCOUNT	=>
     {
	 en => q{+ login & password for the wanted account},
	 es => q{+ login y clave de la cuenta deseada},
     },
     ALIAS	=>
     {
	 en => q{+ nick erases or creates an alias for the given address},
	 es => q{+ nick borra o crea un alias para la direccion dada},
     },
     CHECK	=>
     {
	 en => q{checks mailbox for spam. With !, removes it},
	 es => q{revisa el buzon buscando spam. Con ! lo borra},
     },
     SEND	=>
     {
	 en => q{+ recipients and subject in the first line sends email},
	 es => q{+ destinatarios y asunto en la 1a linea envia un email},
     },
     INTERFACE	=>
     {
	 en => q{+ language, changes the language for the responses},
	 es => q{+ lenguage, cambia el lenguaje para las respuestas},
     },
     LIST	=>
     {
	 en => q{returns the amount of messages in the registered account},
	 es => q{contesta la cantidad de mensajes en la cuenta registrada},
     },
     DELETE	=>
     {
	 en => q{+ msg number removes it from the mailbox},
	 es => q{+ numero de mens lo remueve del buzon},
     },
     REPLY	=>
     {
	 en => q{+ msg number replies the remainder of the SMS},
	 es => q{+ numero de mens contesta el resto del SMS},
     },
     ALL	=>
     {
	 en => q{+ msg number replies the remainder of the SMS to all},
	 es => q{+ numero de mens contesta el resto del SMS a todos},
     },
     FORWARD	=>
     {
	 en => q{+ msg number + dest addr + the remainder of the SMS},
	 es => q{+ numero de mens + dest + el resto del SMS},
     },
     GET	=>
     {
	 en => q{+ msg number fetches it from the mailbox},
	 es => q{+ numero de mens lo trae del buzon},
     },
     HELP	=>
     {
	 en => q{sends this help text},
	 es => q{envia estos textos de ayuda},
     },
     );


=pod

=head2 RESPONSE TABLE

The commands must supply responses to the user based on its
success. In order to support multiple languages, responses are stored
in a hash table (C<%SMS::Handler::Email::Messages>). Each key on this
hash table correspond to a language tag as described in
L. The corresponding value, is a reference to a hash
whose keys are message tags (ie, an identifier for the message) and a
message in the required language.

Please see the source code for the specific message identifiers
used. Note that you must call C if this table is changed.

Supported languages must be added to the
C<%SMS::Handler::Email::SupportedLangages> hash before calling the
init method.

=cut
    ;

my %SupportedLanguages =
(
 'SPANISH'	=> 'es',
 'ESPAÑOL'	=> 'es',
 'CASTELLANO'	=> 'es',
 'ESPANOL'	=> 'es',
 'INGLÉS'	=> 'en',
 'INGLES'	=> 'en',
 'ENGLISH'	=> 'en',
 );

my %Languages;

my $DefaultLanguage = 'en';

our %Messages =
    (
     en =>
     {
	 HANDLE_CMD_ERR	=> q{Command error},
	 ACCOUNT_OK	=> q{ok},
	 ALIAS_OK	=> q{updated},
	 LANG_OK	=> q{interface set to},
	 SEND_OK	=> q{Send ok},
	 DELETE_OK	=> q{deleted ok},
	 REPLY_OK	=> q{replied ok},
	 FWD_OK		=> q{forwarded ok},
	 LIST_NO_REG	=> q{Use .ACCOUNT to register an email account},
	 HEAD_SUBJECT	=> q{Sub:},
	 HEAD_DATE	=> q{Date:},
	 HEAD_FROM	=> q{From:},
	 HEAD_PHONE	=> q{Phone:},
	 REPLY_YOU	=> q{You},
	 REPLY_SAID	=> q{said:},
	 MSG_COUNT_ONE	=> q{Message},
	 MSG_COUNT_MANY	=> q{Messages},
	 MSG_COUNT_LAST	=> q{Last},
	 HTML_TRANS	=> q{[Translated from HTML]},
	 FETCH_NOMSG	=> q{POP Error. No message},
	 FETCH_MIME	=> q{Error parsing MIME message},
	 FETCH_BODY	=> q{POP Error in fetching body},
	 POP_CONNECT	=> q{POP Error connecting to server},
	 POP_USER	=> q{POP Error in USER},
	 POP_PASS	=> q{POP Error in PASS (Invalid password?)},
	 POP_DELE	=> q{POP Error in DELE},
	 POP_POPSTAT	=> q{POP Error in STAT},
	 POP_QUIT	=> q{POP Error in QUIT},
	 SMTP_CONNECT	=> q{Error connecting to SMTP server},
	 SMTP_MAIL	=> q{SMTP Error in MAIL FROM},
	 SMTP_RCPT	=> q{SMTP: Check your destination addresses},
	 SMTP_DATA	=> q{SMTP Error in DATA},
	 SMTP_HDATASEND	=> q{SMTP Error sending message header},
	 SMTP_BDATASEND	=> q{SMTP Error sending message body},
	 SMTP_DATAEND	=> q{SMTP Error committing message},
	 SMTP_QUIT	=> q{SMTP Error in QUIT},
	 CHK_SPAM_ONE	=> q{spam message},
	 CHK_SPAM_MANY	=> q{spam messages},
	 CHK_DEL_ONE	=> q{message deleted},
	 CHK_DEL_MANY	=> q{messages deleted},
	 TRUNC_START	=> q{[only },
	 TRUNC_END	=> q{octets shown]},
	 ATTACH		=> q{attach},
	 MSG_SHORT	=> q{Message does not have that many segments},
     },
     es =>
     {
	 HANDLE_CMD_ERR	=> q{Error en el comando},
	 ACCOUNT_OK	=> q{ok},
	 ALIAS_OK	=> q{ha sido actualizado},
	 LANG_OK	=> q{Interfaz en},
	 SEND_OK	=> q{Enviado correctamente},
	 DELETE_OK	=> q{borrado correctamente},
	 REPLY_OK	=> q{contestado correctamente},
	 FWD_OK		=> q{re-enviado ok},
	 LIST_NO_REG	=> q{Use .ACCOUNT para asociar una cuenta de correo},
	 HEAD_SUBJECT	=> q{Asunto:},
	 HEAD_DATE	=> q{Fecha:},
	 HEAD_FROM	=> q{De:},
	 HEAD_PHONE	=> q{Tel:},
	 REPLY_YOU	=> q{Usted},
	 REPLY_SAID	=> q{dijo:},
	 MSG_COUNT_ONE	=> q{Mensaje},
	 MSG_COUNT_MANY	=> q{Mensajes},
	 MSG_COUNT_LAST	=> q{Ultimo},
	 HTML_TRANS	=> q{[Traducido de HTML]},
	 FETCH_NOMSG	=> q{Error POP. No existe el mensaje},
	 FETCH_MIME	=> q{Error interpretando mensaje MIME},
	 FETCH_BODY	=> q{Error POP en la extraccion del mensaje},
	 POP_CONNECT	=> q{Error POP conectandose al servidor},
	 POP_USER	=> q{Error POP en comando USER},
	 POP_PASS	=> q{Error POP en comando PASS (Clave incorrecta?)},
	 POP_DELE	=> q{Error POP en comando DELE},
	 POP_POPSTAT	=> q{Error POP en comando STAT},
	 POP_QUIT	=> q{Error POP en comando QUIT},
	 SMTP_CONNECT	=> q{Error en conexion al servidor SMTP},
	 SMTP_MAIL	=> q{Error SMTP en comando MAIL FROM},
	 SMTP_RCPT	=> q{SMTP: Revise direcciones de destino},
	 SMTP_DATA	=> q{Error SMTP en comando DATA},
	 SMTP_HDATASEND	=> q{Error SMTP enviando encabezado del mensaje},
	 SMTP_BDATASEND	=> q{Error SMTP enviando el cuerpo del mensaje},
	 SMTP_DATAEND	=> q{Error SMTP terminando el envio},
	 SMTP_QUIT	=> q{Error SMTP terminando la sesion},
	 CHK_SPAM_ONE	=> q{mensaje spam},
	 CHK_SPAM_MANY	=> q{mensajes spam},
	 CHK_DEL_ONE	=> q{mensaje borrado},
	 CHK_DEL_MANY	=> q{mensajes borrados},
	 TRUNC_START	=> q{[solo se muestra un bloque de },
	 TRUNC_END	=> q{octetos]},
	 ATTACH		=> q{anexo},
	 MSG_SHORT	=> q{El mensaje no contiene tantos segmentos},
     },
     );

sub _msg
{
    my $self	= shift;
    my $code	= shift;

    my $lang = $self->{_state}->{lang} || $DefaultLanguage;
    return ${$self->{messages}}{$lang}->{$code} || "*** NO MESSAGE $lang/$code ***";
}

sub _init_state
{
    my $self	= shift;

    $self->{pops} && $self->{pops}->quit;
    $self->{e} && $self->{e}->purge;

    $self->{trunc}	= undef;
    $self->{mime}	= undef;
    $self->{body}	= undef;
    $self->{pops}	= undef;
    $self->{msg}	= undef;
    $self->{num}	= undef;
    $self->{e}		= undef;

    $self->{part}	= 1;
}

sub _fetch_state
{
    my $self	= shift;
    my $source	= shift;
    warn "Email: Fetch state for $source\n" if $Debug;
    $self->{_state} = $self->{state}->{$source};
    $self->{_state} || $self->fixup_state($source);
    $self->{_state} ||= {};
}

sub _store_state
{
    my $self	= shift;
    my $source	= shift;
    warn "Email: Store state for $source\n" if $Debug;
    $self->{state}->{$source} = $self->{_state};
}

sub _canon_ref
{
    my $ref	= shift;
    $$ref = lc $$ref unless $$ref =~  m/[[:lower:]]/;
    return $ref;
}

sub init
{
    my $self = shift;
    %Languages = abbrev keys %SupportedLanguages;
    $self->{abbrevs} = { abbrev keys %{$self->{cmds}} };

				# These are used to convert messages back
				# to plain ASCII

    $self->{map} = Unicode::Map8->new('ASCII');

    for my $m (
	       [ ' ', [ 160 ] ], [ '!', [ 161 ] ], [ 'c', [ 162, 231 ] ],
	       [ 'L', [ 163 ] ], [ '*', [ 164, 188 .. 190 ] ],
	       [ 'Y', [ 165 ] ], [ '|', [ 166 ] ], [ 'S', [ 167 ] ],
	       [ '^', [ 168 ] ], [ 'C', [ 169, 199 ] ],
	       [ 'a', [ 170, 224 .. 230 ] ], [ '<', [ 171 ] ],
	       [ '!', [ 172 ] ], [ '-', [ 173, 175 ] ], [ 'R', [ 174 ] ],
	       [ 'o', [ 176, 186 ] ], [ '+', [ 177 ] ], [ '2', [ 178 ] ],
	       [ '3', [ 179 ] ], [ 'u', [ 181 ] ], [ 'P', [ 182, 222, 254 ] ],
	       [ '.', [ 183 ] ], [ ',', [ 184 ] ], [ '1', [ 185 ] ],
	       [ '>', [ 187 ] ], [ '?', [ 191 ] ], [ 'A', [ 192 .. 198 ] ],
	       [ 'E', [ 200 .. 203, 208 ] ], [ 'I', [ 204 .. 207 ] ],
	       [ 'N', [ 209 ] ], [ 'O', [ 210 .. 214, 216 ] ],
	       [ 'x', [ 215 ] ], [ 'U', [ 217 .. 220 ] ], [ 'Y', [ 221 ] ],
	       [ 'B', [ 223 ] ], [ 'e', [ 232 .. 235, 240 ] ],
	       [ 'i', [ 236 .. 239 ] ], [ 'n', [ 241 ] ],
	       [ 'o', [ 242 .. 246, 248 ] ], [ '/', [ 247 ] ],
	       [ 'u', [ 249 .. 251 ] ], [ 'y', [ 252, 255 ] ],
	       )
    {
	for (@{$m->[1]})
	{
	    $self->{map}->addpair($_, ord($m->[0]));
	}
    }

    $self->{map}->default_to16(ord('?'));
    $self->{map}->default_to8(ord('?'));
    return $self;
}

=pod

The following methods are provided:

=over 4

=item C<-Enew()>

Creates a new C object. It accepts parameters as a
number of key / value pairs. The following parameters are supported.

=over 2

=item C $queue_obj>

An object obeying the interface defined in L, where the
response message generated by this module will be stored.

=item C $ref_to_hash>

Reference to a (potentially Cd) hash where state about the user
will be stored. Passwords will be stored in this hash, under the
protection of reversible crypto. Therefore, care must be taken to
prevent unauthorized access to this.

=item C $my_secret_phrase>

A secret phrase used to obscure the passwords stored for the users.

=item C $my_addr>

The address assigned to this service, in B format. The
destination address of the SMS, must match this argument. If this
address is left unspecified, the SMS will be accepted no matter what
destination address is used.

=item C $your_pop_server>

The name or IP address of the POP server.

=item C $your_smtp_server>

The name or IP address of the SMTP server.

=item C $max_sms_length>

Maximum length of an SMS. Defaults to 160.

=item C $max_message_length>

The amount of bytes to fetch from the body of the email. Defaults to
1024 bytes.

=item C $fold_whitespace>

If set to a true value (the default) forces successions of whitespace
to be folded into single spaces. This generally improves readability
of the SMS.

=item C $obj>

If passed, this is assumed to be an object supporting a
C<-Echeck()> method as described in L. This is
used to test fetched messages for SPAM-iness.

=item C $hashref>

Allows the specification of a new command table which overrides the
default.

=item C $max>

Defines the maximum number of messages to check for spamminess for
each B command. Defaults to test all the messages. Note that
checking a large number of messages at once can take very long.

=back

=cut

sub new
{
    my $name	= shift;
    my $class	= ref($name) || $name;

    my %self = validate_with
	(
	  params	=> \@_,
	  ignore_case	=> 1,
	  strip_leading	=> '-',
	  spec =>
	  {
	      queue =>
	      {
		  type		=> OBJECT,
		  can		=> [ qw(store) ],
	      },
	      state =>
	      {
		  type		=> HASHREF,
	      },
	      secret =>
	      {
		  type		=> SCALAR,
	      },
	      addr =>
	      {
		  type		=> SCALAR,
		  default	=> undef,
		  callbacks	=>
		  {
		      'address format' => sub { $_[0] =~ /^\d+\.\d+\.\d+$/; }
		  }
	      },
	      pop =>
	      {
		  type		=> SCALAR,
	      },
	      smtp =>
	      {
		  type		=> SCALAR,
	      },
	      maxlen =>
	      {
		  type		=> SCALAR,
		  default	=> 160,
	      },
	      maxfetch =>
	      {
		  type		=> SCALAR,
		  default	=> 1024,
	      },
	      compact =>
	      {
		  type		=> SCALAR,
		  default	=> 1,
	      },
	      spamcheck =>
	      {
		  type		=> OBJECT,
		  default	=> undef,
		  can		=> [ qw(check) ],
	      },
	      spammax =>
	      {
		  type		=> SCALAR,
		  default	=> undef,
		  callbacks	=>
		  {
		      'must be possitive' => sub {
			  $_[0] > 0;
		      },
		  },
	      },
	      cmds =>
	      {
		  type		=> HASHREF,
		  default	=>
		  {
		      ACCOUNT	=> \&_CMD_ACCOUNT,
		      ALIAS	=> \&_CMD_ALIAS,
		      CHECK	=> \&_CMD_CHECK,
		      SEND	=> \&_CMD_SEND,
		      INTERFACE	=> \&_CMD_INTERFACE,
		      LIST	=> \&_CMD_LIST,
		      DELETE	=> \&_CMD_DELETE,
		      REPLY	=> \&_CMD_REPLY,
		      ALL	=> \&_CMD_REPLY_ALL,
		      FORWARD	=> \&_CMD_FORWARD,
		      GET	=> \&_CMD_GET,
		      HELP	=> \&_CMD_HELP,
		  }
	      },
	      help =>
	      {
		  type         => HASHREF,
                  default      => \%Help
	      },
              messages =>
              {
                  type         => HASHREF,
                  default      => \%Messages
              }
	  }
	  );
    if ($self{addr})
    {
	($self{ton}, $self{npi}, $self{number}) = split(/\./, $self{addr}, 3);
    }

    $self{mp} = new MIME::Parser;
    $self{mp}->ignore_errors(1);
    $self{mp}->extract_uuencode(1);

    $self{body}	= '';
    $self{head}	= undef;
    $self{wd}	= undef;
    $self{part} = 0;

    my $ret = bless \%self, $class;

    $self{parser} =
    {
	'text/html' =>
	  HTML::Parser->new
	      (
	       api_version => 3,
	       default_h		=> [ "" ],
	       start_h		=>
	       [ sub
		 {
		     my $p	= shift;
		     my $tag	= shift;
		     my $attr	= shift;

		     return unless ($tag eq 'img');
		     $ret->{body} .= '[IMG';
		     $ret->{body} .= ' ' . $attr->{alt} if $attr->{alt};
		     $ret->{body} .= ']';

		     $p->eof if length($ret->{body})
			 > $ret->{part} * $ret->{maxfetch};
		 },
		 "self, tagname, attr" ],

	       text_h =>
	       [ sub
		 {
		     my $p = shift;
		     $ret->{body} .= shift;
		     $p->eof if length($ret->{body})
			 > $ret->{part} * $ret->{maxfetch};
		 },
		 "self, dtext" ],
	       ),
    };

    $ret->{parser}->{'text/html'}->ignore_elements(qw(script style));
    $ret->{parser}->{'text/html'}->strict_comment(1);
    return $ret->init;
}

=pod

=item C<-Ehandle()>

Process the given SMS. Commands are taken from a dispatch table and
appropiate handlers are called. Commands must be in the first line of
the SMS.

An exception to this rule, is the fancy syntax supported by some
phones, that looks like

    [e-mail](subject)this is the message body
    [e-mail] (subject) this is the message body
    you(subject)this is the message body
    you (subject) this is the message body

This syntax is transparently converted to our command based syntax.

=cut

sub handle
{
    my $self = shift;
    my $hsms = shift;

    warn "Email: handle for ", $hsms->{source_addr}, "\n" if $Debug;

    $self->fixup_sms($hsms);

    return $self->SUPER::handle($hsms, @_);
}

=pod

=item C<-Edispatch_error>

Produce an error when a given command does not exist. Causes the
current SMS to be discarded from the queue.

=cut

sub dispatch_error
{
    my $self = shift;
    my $hsms = shift;
    my $source = shift;
    my $msg = shift;

    warn "Email: command not understood in $$msg\n" if $Debug;
    $self->_answer($hsms, \ ($self->_msg('HANDLE_CMD_ERR')
			     . " <$$msg>"));
    return SMS_STOP | SMS_DEQUEUE;
}

=pod

=item C<-E_CMD_ACCOUNT>

Handler method for the ACCOUNT command. Note that access to the
underlying hash (C<$self-E{state}>) must be done in a manner that
C likes, as most likely the passed hash is tied using this
class.

Also, the implementation must assume that other items of state
information might be stored in that hash. Those items should be
preserved.

=cut

sub _CMD_ACCOUNT
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

#    warn "# I'm here with msg = $$r_msg\n";
#    warn "# I'm here with body = $$r_body\n";

    $$r_msg =~ s/^\.\w+\s+(\S+)\s+(.+)\s*//;

    return unless defined $1 and defined $2;

    warn "Email: account map $source -> $1\n" if $Debug;
    $self->_init_state;
    $self->_fetch_state($source);
    $self->{_state}->{login} = $1;
    $self->{_state}->{passwd} = $self->_crypt($2);
    $self->{_state}->{ac_time} = time;
    $self->_store_state($source);
    $self->_init_state;
    $self->_answer($hsms, \ ($self->{_state}->{login}
			     . ' ' . $self->_msg('ACCOUNT_OK')));
    return 1;
}

=pod

=item C<-E_CMD_ALIAS>

Handler method for the ALIAS command.

=cut

sub _CMD_ALIAS
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^(\s+([^\s]+))?\s+(\w+)\s*//;

    return unless defined $1;

    my $alias = lc $3;
    my $email = lc $1;

    warn "Email: _CMD_ALIAS $alias $email\n" if $Debug;

    $self->_init_state;
    $self->_fetch_state($source);

    unless ($self->_authen($hsms, $source))
    {
	warn "Email: authentication failed for $source\n" if $Debug;
	return;
    }

    if ($email)
    {
	$self->{_state}->{alias}->{$alias} = $email;
	warn "Email: stored $alias => $email\n" if $Debug;
    }
    else
    {
	delete $self->{_state}->{alias}->{$alias};
	warn "Email: deleted $alias\n" if $Debug;
    }

    $self->_store_state($source);

    $self->_answer($hsms, \ ($alias . ' ' . $self->_msg('ALIAS_OK')
			     . ". $self->{num} " .
			     ($self->{num} == 1 ?
			      $self->_msg('MSG_COUNT_ONE') :
			      $self->_msg('MSG_COUNT_MANY'))));
    $self->_init_state;
    return 1;
}
=pod

=item C<-E_CMD_INTERFACE>

Handler for setting the interface language.

=cut

sub _CMD_INTERFACE
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

#    warn "# I'm here with msg = $$r_msg\n";
#    warn "# I'm here with body = $$r_body\n";

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^\s+(\S+)\s*//;

    return unless defined $1;

    $self->_init_state;
    $self->_fetch_state($source);

    unless (exists $SupportedLanguages{$Languages{uc $1}})
    {
	warn "Email: unsupported language map $source -> $1\n" if $Debug;
	return 0;
    }

    my $lang = $SupportedLanguages{$Languages{uc $1}};

    warn "Email: language map $source -> $lang\n" if $Debug;

    $self->{_state}->{lang} = $lang;
    $self->_store_state($source);

    $self->_answer($hsms, \ ( $self->_msg('LANG_OK') . " <$lang>"));
    $self->_init_state;
    return 1;
}

=pod

=item C<-E_CMD_SEND>

Handler method for the SEND command.

=cut

sub _CMD_SEND
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^\s+(\S+)\s*(.*)\s*$//;

    return unless defined $1 and defined $2;

    my $to	= $1;
    my $subject	= $2;

    warn "Email: _CMD_SEND $to $subject\n" if $Debug;

    $self->_init_state;
    $self->_fetch_state($source);

    $self->{body} = $ { _canon_ref($r_body)};

    if ($self->_authen($hsms, $source)
	and $self->_deliver($hsms, $source, $self->_expanded_addresses($to),
			    $subject))
   {
	warn "Email: send from $source to $to ok with $self->{num} msgs\n"
	    if $Debug;
	if ($self->{num} == 1)
	{
	    $self->_answer($hsms, \ ( $self->_msg('SEND_OK')
				      . ". $self->{num} "
				      . $self->_msg('MSG_COUNT_ONE')));
	}
	else
	{
	    $self->_answer($hsms, \ ( $self->_msg('SEND_OK')
				      . ". $self->{num} "
				      . $self->_msg('MSG_COUNT_MANY')));
	}
	$self->_init_state;
	return 1;
    }

    warn "Email: deliver for $source failed\n";
    $self->_init_state;
    return;
}

=pod

=item C<-E_CMD_LIST>

Handler method for the LIST command.

=cut

sub _CMD_LIST
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+\s*//;

    $self->_init_state;
    $self->_fetch_state($source);

    if (exists $self->{_state}->{login})
    {
	if ($self->_authen($hsms, $source))
	{
	    my $last = $self->{pops}->last;
	    warn "Email: list with $self->{num} msgs\n" if $Debug;
	    if ($self->{num} == 1)
	    {
		$self->_answer($hsms,
			       \ ($self->{num} . " " .
				  $self->_msg('MSG_COUNT_ONE')
				  . ($last ? ". "
				     . $self->_msg('MSG_COUNT_LAST')
				     . " $last" : '')));
	    }
	    else
	    {
		$self->_answer($hsms,
			       \ ($self->{num} . " " .
				  $self->_msg('MSG_COUNT_MANY')
				  . ($last ? ". "
				     . $self->_msg('MSG_COUNT_LAST')
				     . " $last" : '')));
	    }
	    $self->_init_state;
	    return 1;
	}

	warn "Email: authentication failed for $source\n" if $Debug;
	$self->_init_state;
	return;
    }
    else
    {
	warn "Email: No account for $source\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('LIST_NO_REG')));
	$self->_init_state;
	return;
    }
}

=pod

=item C<-E_CMD_HELP>

Handler method for the HELP command. Sends a SMS message for each
supported command, containing the help messages defined.

=cut

sub _CMD_HELP
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^(\s+(\w+))?\s*//;

    my $cmd = $2;

    warn "Email: $source wants help on ",
    (defined $cmd ? $cmd : 'all commands '),
    "\n" if $Debug;

    $self->_init_state;
    $self->_fetch_state($source);

    my $lang = $self->{_state}->{lang} || $DefaultLanguage;
    my @list;

    if ($cmd)
    {
	$cmd = uc $cmd;
	$cmd = $self->{abbrevs}->{$cmd} unless exists $self->{cmds}->{$cmd};
	@list = grep { $cmd eq $_ } keys %{ $self->{cmds} };
    }

    @list = keys %{$self->{help}} unless @list;

    $self->_answer($hsms, \ ($_ . "\n" .
			     ${$self->{help}}{$_}->{$lang})) for (sort @list);

    $self->_init_state;
    return 1;
}

=pod

=item C<-E_CMD_DELETE>

Handler method for the DELETE command.

=cut

sub _CMD_DELETE
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^\s*(\S+)?\s*//;

    $self->_init_state;
    $self->_fetch_state($source);
    $self->{msg} = $1 || $self->{num} || 1;

    if ($self->_dele($hsms, $source)
	and $self->_quit($hsms, $source))
    {
	warn "Email: $source delete $source $self->{msg}\n" if $Debug;
	if ($self->{num} == 1)
	{
	    $self->_answer($hsms, \ ( $self->{msg} . " "
				      . $self->_msg('DELETE_OK')
				      . ". $self->{num} "
				      . $self->_msg('MSG_COUNT_ONE')));
	}
	else
	{
	    $self->_answer($hsms, \ ( $self->{msg} . " "
				      . $self->_msg('DELETE_OK')
				      . ". $self->{num} "
				      . $self->_msg('MSG_COUNT_MANY')));
	}
	$self->_init_state;
	return 1;
    }
    $self->_init_state;
    return;
}



=pod

=item C<-E_CMD_REPLY>

Handler method for the REPLY command.

=cut

sub _CMD_REPLY
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^(\s*!)?\s*(\d+)?\s*//;

				# Fetch the selected message
    $self->_init_state;
    $self->_fetch_state($source);

    $self->{trunc} = !$1;
    $self->{mime} = $1;
    $self->{msg} = $2;

    if (defined $self->{msg})
    {
	$self->{msg} ||= 1;
    }
    else
    {
	$self->_authen($hsms, $source);
	$self->{msg} ||= $self->{num} || 1;
    }


    if ($self->_fetch($hsms, $source))
    {

	my $from = $self->d_m($self->{head}->get('From'))
		|| $self->_msg('REPLY_YOU');

	my $sub = $self->d_m($self->{head}->get('Subject'));

	my $text = '';

	substr($text, 0, 0, "\n");
	substr($text, 0, 0, $sub);
	substr($text, 0, 0, 'Subject: ');

	substr($text, 0, 0, $self->{head}->get('Date'));
	substr($text, 0, 0, 'Date: ');

	if ($self->{head}->get('Cc'))
	{
	    substr($text, 0, 0, $self->d_m($self->{head}->get('Cc')));
	    substr($text, 0, 0, 'Cc: ');
	}

	if ($self->{head}->get('To'))
	{
	    substr($text, 0, 0, $self->d_m($self->{head}->get('To')));
	    substr($text, 0, 0, 'To: ');
	}

	substr($text, 0, 0, $from);
	substr($text, 0, 0, 'From: ');

	chomp $from;

	substr($text, 0, 0, "\n\n");
	substr($text, 0, 0, $self->_msg('REPLY_SAID'));
	substr($text, 0, 0, "$from ");

	substr($text, 0, 0, "\n\n\n");
	substr($text, 0, 0, $ {_canon_ref($r_body)});

	substr($sub, 0, 0, "Re: ");

	$self->{e}->add_part
	    (MIME::Entity->build(Type => 'text/plain',
				 Data => $text),
	     0);
	$self->{e}->sync_headers(Length => 'COMPUTE');

	if ($self->{mime})
	{
	    $self->{body} = '';
	}
	else
	{
	    $self->_truncate($hsms, $source);
	}

	if ($self->_deliver($hsms, $source,
			    _addresses($self->{head}->get('Reply-To')
				       || $self->{head}->get('From')),
			    $sub))
	{
	    warn "Email: $source reply $self->{msg}\n" if $Debug;
	    $self->_answer($hsms, \ ( $self->{msg} . " "
				      . $self->_msg('REPLY_OK')));
	    $self->_init_state;
	    return 1;
	}
    }

    warn "Email: Failed $source reply $self->{msg}\n" if $Debug;
    $self->_init_state;
    return 0;
}

=pod

=item C<-E_CMD_REPLY_ALL>

Handler method for the ALL command.

=cut

sub _CMD_REPLY_ALL
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^(\s*!)?\s*(\d+)?\s*//;

				# Fetch the selected message
    $self->_init_state;
    $self->_fetch_state($source);

    $self->{trunc} = !$1;
    $self->{mime} = $1;
    $self->{msg} = $2;

    if (defined $self->{msg})
    {
	$self->{msg} ||= 1;
    }
    else
    {
	$self->_authen($hsms, $source);
	$self->{msg} ||= $self->{num} || 1;
    }

    if ($self->_fetch($hsms, $source))
    {

	my $from = $self->d_m($self->{head}->get('From'))
		|| $self->_msg('REPLY_YOU');

	my $sub = $self->d_m($self->{head}->get('Subject'));

	my $text = '';

	substr($text, 0, 0, "\n");
	substr($text, 0, 0, $sub);
	substr($text, 0, 0, 'Subject: ');

	substr($text, 0, 0, $self->{head}->get('Date'));
	substr($text, 0, 0, 'Date: ');

	if ($self->{head}->get('Cc'))
	{
	    substr($text, 0, 0, $self->d_m($self->{head}->get('Cc')));
	    substr($text, 0, 0, 'Cc: ');
	}

	if ($self->{head}->get('To'))
	{
	    substr($text, 0, 0, $self->d_m($self->{head}->get('To')));
	    substr($text, 0, 0, 'To: ');
	}

	substr($text, 0, 0, $from);
	substr($text, 0, 0, 'From: ');

	chomp $from;

	substr($text, 0, 0, "\n\n");
	substr($text, 0, 0, $self->_msg('REPLY_SAID'));
	substr($text, 0, 0, "$from ");

	substr($text, 0, 0, "\n\n\n");
	substr($text, 0, 0, $ {_canon_ref($r_body)});

	substr($sub, 0, 0, "Re: ");

	$self->{e}->add_part
	    (MIME::Entity->build(Type => 'text/plain',
				  Data => $text),
	     0);
	$self->{e}->sync_headers(Length => 'COMPUTE');

	if ($self->{mime})
	{
	    $self->{body} = '';
	}
	else
	{
	    $self->_truncate($hsms, $source);
	}

	if ($self->_deliver($hsms, $source,
			    _addresses(($self->{head}->get('Reply-To')
					|| $self->{head}->get('From'))
				       . ($self->{head}->get('Cc') ?
					  ',' . $self->{head}->get('Cc') :
					  '')),
			    $sub))
	{
	    warn "Email: $source reply $self->{msg}\n" if $Debug;
	    $self->_answer($hsms, \ ( $self->{msg} . " "
				      . $self->_msg('REPLY_OK')));
	    $self->_init_state;
	    return 1;
	}
    }

    warn "Email: Failed $source reply $self->{msg}\n" if $Debug;
    $self->_init_state;
    return 0;
}

=pod

=item C<-E_CMD_FORWARD>

Handler method for the FORWARD command.

=cut

sub _CMD_FORWARD
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^(\s*!)?(\s+(\d+))?\s*(\S+)\s*$//;

    return unless defined $4;

				# Fetch the selected message
    $self->_fetch_state($source);
    $self->_init_state;

    $self->{mime} = $1;
    $self->{trunc} = !$1;
    $self->{msg} = $3;
    my $to  = $4;

    if (defined $self->{msg})
    {
	$self->{msg} ||= 1;
    }
    else
    {
	$self->_authen($hsms, $source);
	$self->{msg} ||= $self->{num} || 1;
    }

    if ($self->_fetch($hsms, $source))
    {
	my $from = $self->d_m($self->{head}->get('From'))
		|| $self->_msg('REPLY_YOU');

	my $sub = $self->d_m($self->{head}->get('Subject'));

	my $text = '';

	substr($text, 0, 0, "\n");
	substr($text, 0, 0, $sub);
	substr($text, 0, 0, 'Subject: ');

	substr($text, 0, 0, $self->{head}->get('Date'));
	substr($text, 0, 0, 'Date: ');

	if ($self->{head}->get('Cc'))
	{
	    substr($text, 0, 0, $self->d_m($self->{head}->get('Cc')));
	    substr($text, 0, 0, 'Cc: ');
	}

	if ($self->{head}->get('To'))
	{
	    substr($text, 0, 0, $self->d_m($self->{head}->get('To')));
	    substr($text, 0, 0, 'To: ');
	}

	substr($text, 0, 0, $from);
	substr($text, 0, 0, 'From: ');

	chomp $from;

	substr($text, 0, 0, "\n\n");
	substr($text, 0, 0, $self->_msg('REPLY_SAID'));
	substr($text, 0, 0, "$from ");

	substr($text, 0, 0, "\n\n\n");
	substr($text, 0, 0, $ { _canon_ref($r_body)});

	substr($sub, 0, 0, "Fwd: ");

	my %mime = ();

	$self->{e}->add_part(MIME::Entity->build(Type => 'text/plain',
						 Data => $text),
			     0);
	$self->{e}->sync_headers(Length => 'COMPUTE');

	if ($self->{mime})
	{
	    $self->{body} = '';
	}
	else
	{
	    $self->_translate($hsms, $source);
	    $self->_truncate($hsms, $source);
	}

	if ($self->_deliver($hsms, $source,
			    $self->_expanded_addresses($to), $sub))
	{
	    warn "Email: $source forward $self->{msg}\n" if $Debug;
	    $self->_answer($hsms, \ ( $self->{msg} . " " .
				      $self->_msg('FWD_OK')));
	    $self->_init_state;
	    return 1;
	}
    }

    warn "Email: Failed $source forward $self->{msg}\n" if $Debug;
    $self->_init_state;
    return 0;
}

=pod

=item C<-E_CMD_GET>

Handler method for the GET command.

=cut

sub _CMD_GET
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^(\s+(\d+))?(\s+(\d+))?\s*//;

    $self->_init_state;
    $self->_fetch_state($source);

    $self->{msg} = $2;
    $self->{part} = $4 || 1;

    if (defined $self->{msg})
    {
	$self->{msg} ||= 1;
    }
    else
    {
	$self->_authen($hsms, $source);
	$self->{msg} ||= $self->{num} || 1;
    }

    if ($self->_fetch($hsms, $source)
	and $self->_translate($hsms, $source)
        and $self->_truncate($hsms, $source))
    {
				# Place the required headers in the email,
				# in as compact a way as possible.

	substr($self->{body}, 0, 0, "\n");
	substr($self->{body}, 0, 0, $self->d_m($self->{head}->get('Subject')));
	substr($self->{body}, 0, 0, " ");
	substr($self->{body}, 0, 0, $self->_msg('HEAD_SUBJECT'));

	substr($self->{body}, 0, 0,
	       strftime "%d/%m/%y %H:%M\n",
	       localtime(str2time($self->{head}->get('Date'))));
	substr($self->{body}, 0, 0, " ");
	substr($self->{body}, 0, 0, $self->_msg('HEAD_DATE'));

	substr($self->{body}, 0, 0, $self->d_m($self->{head}->get('From')));
	substr($self->{body}, 0, 0, " ");
	substr($self->{body}, 0, 0, $self->_msg('HEAD_FROM'));
	if ($self->{head}->get('X-SMS-From'))
	{
	    substr($self->{body}, 0, 0,
		   $self->{head}->get('X-SMS-From'));
	    substr($self->{body}, 0, 0, " ");
	    substr($self->{body}, 0, 0, $self->_msg('HEAD_PHONE'));
	}

	warn "Email: Get $self->{msg}\n" if $Debug;
	$self->_answer($hsms, \$self->{body});
	$self->_init_state;
	return 1;
    }
    $self->_init_state;
    return 0;
}


=pod

=item C<-E_CMD_CHECK>

Handler method for the CHECK command. Only makes sense if
C<-Enew()> is called with B defined. Currently a noop.

=cut

sub _CMD_CHECK
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $r_msg	= shift;
    my $r_body	= shift;

    $$r_msg =~ s/^\.\w+//;
    $$r_msg =~ s/^(\s+(!))?\s*//;

    warn "Email: CHECK: Temporarily out of order\n";
    return;

}

				###########################################
				# Utility functions related to SMS handling
				###########################################

				# Decode a string

sub d_r
{
    my $self	= shift;

    $self->{body} = $self->{map}->to8
	($self->{map}->to16($self->{wd}->decode($self->{body})));

    return 1;
}

sub d_t
{
    my $self	= shift;

    return $self->{map}->to8
	($self->{map}->to16($self->{wd}->decode(shift||'')));

}

sub d_m
{
    my $self = shift;
    return $self->{map}->to8
	($self->{map}->to16($self->{wd}->decode(shift||'')));
}

sub _do_answer
{
    my $self = shift;
    my $hsms = shift;
    my $r_part = shift;

    my $pdu = new Net::SMPP::PDU;

    $pdu->source_addr_ton($self->{ton});
    $pdu->source_addr_npi($self->{npi});
    $pdu->source_addr($self->{number});
    $pdu->dest_addr_ton($hsms->{source_addr_ton});
    $pdu->dest_addr_npi($hsms->{source_addr_npi});
    $pdu->destination_addr($hsms->{source_addr});
    $pdu->short_message($$r_part);

    my ($fh, $qid) = $self->{queue}->store;

    $pdu->nstore_fd($fh);

    unless ($fh->close)
    {
	warn "Email: Invalid response $qid: $!\n" if $Debug;
	$self->{queue}->unlock($qid);
	return;
    }

    warn "Email: Response $qid ok\n" if $Debug;
    $self->{queue}->unlock($qid);
    return 1;
}

sub _addresses
{
    my $addr = shift;
    warn "Email: parsing addresses from $addr\n" if $Debug;
    my @ret = map { $_->address } Mail::Address->parse($addr);
    warn "Email: addresses are ", join(', ', @ret), "\n" if $Debug;
    return \@ret;
}

sub _expanded_addresses
{
    my $self = shift;
    my $addr = shift;

    warn "Email: expanding addresses from $addr\n" if $Debug;

    my @ret = ();
    for my $a (Mail::Address->parse($addr))
    {
	if (defined $self->{_state}->{alias}->{lc $a->address})
	{
	    my ($t) = Mail::Address->parse
		($self->{_state}->{alias}->{lc $a->address});
	    push @ret, $t->address;
	}
	else
	{
	    push @ret, $a->address;
	}
    }
    warn "Email: expanded addresses are ", join(', ', @ret), "\n" if $Debug;
    return [ @ret ];
}

				# This method produces an answer
				# containing $msg as the short message
sub _answer
{
    my $self	= shift;
    my $hsms	= shift;
    my $msg	= shift;

    if (length($$msg) > $self->{maxlen})
    {


				# Here we'll split the message in actual
				# chunks and iterate through them until
				# we get the lengths right.

	my $r_msg = SMS::Handler::Utils::Split_msg($self->{maxlen}, $msg);
	$self->_do_answer($hsms, \$_) || return for @$r_msg;
    }
    else
    {
	$self->_do_answer($hsms, $msg) || return;
    }

    return 1;
}

sub _add_trunc
{
    my $self	= shift;
    my $source	= shift;

    $self->{body} .= "\n\n";
    $self->{body} .= $self->_msg('TRUNC_START');
    $self->{body} .= " " . $self->{maxfetch} . " ";
    $self->{body} .= $self->_msg('TRUNC_END');
    1;
}
				######################################
				# Utility function related to POP3 and
				# SMTP protocols
				######################################
sub _fetch
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;

    $self->{e} = undef;
    $self->{mp}->filer->purge;		# Get rid of old files

    return unless $self->{pops}
	or $self->_authen($hsms, $source);

    my $fh = new_tmpfile IO::File;

    unless ($self->{pops}->get($self->{msg}, $fh))
    {
	warn "Email: POP failure at GET $self->{msg}\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('FETCH_NOMSG')
				 . " ($self->{msg})"));
	return;
    }

    $fh->seek(0, SEEK_SET);

    my $error;			# MIME::Parser error

    eval { $self->{e} = $self->{mp}->parse($fh); };
    $error = ($@ || $self->{mp}->last_error);

    if ($error)
    {
	warn "Email: $source MIME parsing of $self->{msg}: $error\n"
	    if $Debug;
	$self->_answer($hsms, \ ($self->_msg('FETCH_MIME')
				 . " ($self->{msg})"));
	$fh->close;
	$self->{e} = undef;
	$self->{mp}->filer->purge;
	return;
    }

    $fh->close;

    $self->_remove_alternatives
	if (lc $self->{e}->head->get('Content-Type')
	    eq 'multipart/alternative');

    $self->{e}->make_multipart;
    $self->{head} = $self->{e}->head;

    $self->_setup_decoder($self->{e});

    return 1;
}

				# This might be a multipart/alternative
				# message. In this case, get rid of all
				# redundant parts and keep just one.

sub _remove_alternatives
{
    my $self = shift;

    warn "Email: Stripping multipart/alternative\n"
	if $Debug;

    $self->{e}->parts([$self->{e}->parts(0)]);
}

sub _setup_decoder
{
    my $self = shift;
    my $e = shift;

    if ($e
	and $e->head->get('Content-Type')
	and $e->head->get('Content-Type') =~ m!charset="([^\"]+)"!)
    {
	$self->{wd} = MIME::WordDecoder->supported($1)
	    || MIME::WordDecoder->supported('ISO-8859-1');
	warn "wd for $1 is $self->{wd}\n" if $Debug;
    }
    elsif ($self->{head}->get('Content-Type')
	   and $self->{head}->get('Content-Type') =~ m!charset="([^\"]+)"!)
    {
	$self->{wd} = MIME::WordDecoder->supported($1)
	    || MIME::WordDecoder->supported('ISO-8859-1');
	warn "wd for $1 is $self->{wd}\n" if $Debug;
    }
    else
    {
        $self->{wd} = supported MIME::WordDecoder "ISO-8859-1";
	warn "default wd is $self->{wd}\n" if $Debug;
    }
}

sub _translate
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;

				# At this point, $self->{e} should be a
				# MIME::Entity (always Multipart)

    unless ($self->_fetch_helper($hsms, $source, $self->{e}))
    {
	$self->{e} = undef;
	$self->{mp}->filer->purge;
	return;
    }
				# Fold whitespace as much as possible
				# if requested
    if ($self->{compact})
    {
	$self->{body} =~ s/^[[:space:]]*$/\n/mg;
	$self->{body} =~ s/[[:blank:]]+/ /g;
	$self->{body} =~ s/[\r\n]+/\n/msg;
    }

    return 1;
}

sub _truncate
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;

    $self->d_r();

    if (length($self->{body}) < ($self->{part} - 1) * $self->{maxfetch})
    {
	$self->_answer($hsms, \ ($self->_msg('MSG_SHORT')));
	return;
    }

    substr($self->{body}, 0, ($self->{part} - 1) * $self->{maxfetch}, '');

    if (length($self->{body}) > $self->{maxfetch})
    {
	$self->{body} = substr($self->{body}, 0, $self->{maxfetch});
	$self->_add_trunc($source);
    }

    return 1;
}

sub _fetch_helper
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $ent	= shift;

    return 1 if length($self->{body}) > $self->{part} * $self->{maxfetch};

    $self->_setup_decoder($ent);

    if (my @parts = $ent->parts)
    {
	for (@parts)
	{
	    return 1 if length($self->{body})
		> $self->{part} * $self->{maxfetch};
	    my $ret = $self->_fetch_helper($hsms, $source, $_);
	    return unless $ret;
	}
    }
    elsif (my $body = $ent->bodyhandle)
    {
	my $type = $ent->head->mime_type;
	warn "Email: $type: ", Digest::MD5::md5_hex($body->as_string), "\n"
	    if $Debug;
	if ($type eq 'text/plain')
	{
	    $self->{body} .= $body->as_string;
	}
	elsif ($type eq 'text/html')
	{
				# XXX - The assignment to $waste below
				# prevents the decoding process to turn
				# crazy after its first invocation. Looks
				# like a bug to me, but I'm unable to
				# replicate it with a smaller piece of code.
	    my $text = $body->as_string;
	    my $waste = Digest::MD5::md5_hex($text);
	    $self->{parser}->{$type}->parse($text);
	}
	else
	{
	    $self->{body} .= '[';
	    $self->{body} .= $self->_msg('ATTACH');
	    $self->{body} .= " $type ";
	    $self->{body} .= $ent->head->recommended_filename || '';
	    $self->{body} .= ']';
	}
    }
    return 1;
}

sub _dele
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my @msg	= map { /(\d+)-(\d+)/ ? $1 .. $2 : $_ } split /,/,
    $self->{msg};

    return unless $self->{pops}
	or $self->_authen($hsms, $source);

    foreach (@msg)
    {
	unless ($self->{pops}->delete($_))
	{
	    warn "Email: POP failure at DELE $_\n" if $Debug;
	    $self->_answer($hsms, \ ($self->_msg('POP_DELE')
				     . " ($_)"));
	    return;
	}
    }

    unless (defined ($self->{num} = ($self->{pops}->popstat)[0]))
    {
	warn "Email: POP failure at POPSTAT\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('POP_POPSTAT')));
	return;
    }
    return 1;
}

sub _quit
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;

    return unless defined $self->{pops};

    unless ($self->{pops}->quit)
    {
	warn "Email: POP failure at QUIT\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('POP_QUIT')));
	return;
    }

    return 1;
}

sub _authen
{
    my $self = shift;
    my $hsms = shift;
    my $source = shift;

    $self->{pops} = Net::POP3->new($self->{pop},
				  Timeout => 30);
    unless ($self->{pops})
    {
	warn "Email: Can't connect to POP server: $!\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('POP_CONNECT')));
	return;
    }

    unless ($self->{pops}->user($self->{_state}->{login}))
    {
	warn "Email: POP failure at USER\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('POP_USER')));
	return;
    }

    unless ($self->{num} = $self->{pops}->pass
	    ($self->_crypt($self->{_state}->{passwd})))
    {
	warn "Email: POP failure at PASS\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('POP_PASS')));
	return;
    }

    $self->{num} += 0;
    return 1;
}

sub _deliver
{
    my $self	= shift;
    my $hsms	= shift;
    my $source	= shift;
    my $to	= shift;
    my $subject	= shift;
    my $r_head	= shift || {};

    my $smtp = Net::SMTP->new($self->{smtp},
			      Timeout => 30,
			      );

    unless ($smtp)
    {
	warn "Email: Can't connect to SMTP server: $!\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('SMTP_CONNECT')));
	return;
    }

    unless ($smtp->mail($self->{_state}->{login}))
    {
	warn "Email: SMTP error (MAIL FROM): $!\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('SMTP_MAIL')));
	return;
    }

    foreach (@$to)
    {
#	warn "Email: SMTP deliver $_\n";
	unless($smtp->to($_))
	{
	    warn "Email: SMTP error (RCPT TO $_): $!\n" if $Debug;
	    $self->_answer($hsms, \ ($self->_msg('SMTP_RCPT')
				     . " ($_)"));
	    return;
	}
    }

    my $e = MIME::Entity->build(Type => 'multipart/mixed',
				From => $self->{_state}->{login},
				'Reply-To' => $self->{_state}->{login},
				To => shift @$to,
				Cc => join(', ', @$to),
				Subject => $subject,
				'X-Mailer' => 'SMS::Handler::Email '
				. $VERSION,
				'X-SMS-From' =>
				$self->fixup_phone($hsms, $source),
				);

    $e->attach(Type => 'text/plain',
	       Data => $self->{body});

    if ($self->{e})
    {
	$e->add_part($_) for $self->{e}->parts;
    }

    $e->sync_headers(Length => 'COMPUTE');

    unless ($smtp->data)
    {
	warn "Email: SMTP error (DATA): $!\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('SMTP_DATA')));
	return;
    }

    unless ($smtp->datasend($e->as_string))
    {
	warn "Email: SMTP error (DATASEND header): $!\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('SMTP_HDATASEND')));
	return;
    }

    unless ($smtp->dataend)
    {
	warn "Email: SMTP error (DATAEND): $!\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('SMTP_DATAEND')));
	return;
    }

    unless ($smtp->quit)
    {
	warn "Email: SMTP error (QUIT): $!\n" if $Debug;
	$self->_answer($hsms, \ ($self->_msg('SMTP_QUIT')));
	return;
    }

    return 1;
}

=pod

=head2 CUSTOMIZABLE HANDLERS

To further enhance the customization of this class, the following
functions can be overriden to tweak the behavior of this module.

=over

=item C

This method is invoked after issuing the call to
C<-E_fetch_state()> (and failing). Its main purpose is to allow
the definition of default credentials for every user. It can return a
false value (the default) to cause an error to be reported when no
credentials are available. This function should provide values to
C<$self-E{_state}>. It is called with the source address of the
cellular phone in the format C.

=cut

sub fixup_state { return; }

=pod

=item C

This function is used to convert a number in C format
to a phone number as expected by cellular users. It must return the
phone number as expected by the user.

=cut

sub fixup_phone { return (split(/\./, $_[2], 3))[2]; }

=pod

=item C

This function is invoked from within the C<-Ehandle> method,
before dispatching to the handlers. This can be used to perform custom
transformations in the messages before processing. The default method,
provides a translation from Nokia-like syntax into the expected
B<.SEND> syntax.

=cut

sub fixup_sms
{
    my $self = shift;
    my $hsms = shift;

				# This handles a somewhat common syntax
				# for writing an email on an SMS.

    if ($hsms->{short_message}
	=~ s/^(\(\d+\) )?\s*([^\.\(\)][^\(]*)\(([^\)]*)\)\s*//)
    {
	warn "Email: Converting to .SEND syntax\n" if $Debug;
	substr($hsms->{short_message}, 0, 0,
	       ".SEND $2 " . (defined($3) ? $3 : 'No Subject') . "\n");
    }
}

=pod

=back

=head2 ENCRYPTION OF THE USER PASSWORDS

The encription of the user passwords is intended to prevent a casual
observer looking at the hash, from getting the passwords. Since the
crypto is both, simplistic and reversible, you should assume that any
compromise of the hash containing the passwords lead directly to
password compromise.

=cut

sub _crypt
{
    my $self = shift;
    my $text = reverse shift;

    my $key = '';
    my $ret = '';

    $key .= $self->{secret} while length($key) < length($text);
    $key = substr($key, 0, length($text));

    while (my $k = chop ($key))
    {
	my $t = chop $text;
	$ret .= chr(ord($k) ^ ord($t));
    }

    return $ret;
}

1;

__END__