http://search.cpan.org/~aau/Net-MRIM/

package MMPSMS;

$VERSION = '0.1';

=pod

=head1 NAME

MMPSMS - sends sms messages using MMP proto.

=head1 DESCRIPTION

Read about Mail.ru Agent SMS functionality here: 
http://agent.mail.ru/help/3/1.html

=head1 SYNOPSIS

To construct object and login to mrim-server:

 my $mmpsms = MMPSMS->new('matrix@mail.ru', 'password');

To add a phone number to contact list:

 my $cid = $mmpsms->add_contact('no_spoon', '+79123456789');

To remove a phone number from contact list:

 $mmpsms->delete_contact($cid, 'no_spoon', '+79123456789');

To send sms:

 $mmpsms->send_sms('no_spoon', 'sms_text_here');

Ping:

 $mmpsms->ping();

Disconnecting:

 $mmpsms->close();


=head1 AUTHOR

Digimortal

=head1 COPYRIGHT

Copyright (c) 2007 Digimortal. 0x48k Crew.

=cut



use IO::Socket::INET;

use constant {

	CS_MAGIC			=> 0xDEADBEEF,
	PROTO_VERSION			=> 0x10008,

	MRIM_CS_HELLO 			=> 0x1001,
	MRIM_CS_HELLO_ACK 		=> 0x1002,

	MRIM_CS_LOGIN2      		=> 0x1038,
	MRIM_CS_LOGIN_ACK 		=> 0x1004,
	MRIM_CS_LOGIN_REJ 		=> 0x1005,
	MRIM_CS_LOGOUT			=> 0x1013,

	MRIM_CS_PING 			=> 0x1006,

	MRIM_CS_USER_STATUS		=> 0x100f,
	    STATUS_OFFLINE	 	=> 0,

	MRIM_CS_ADD_CONTACT 		=> 0x1019,
  	    CONTACT_FLAG_REMOVED	=> 1,
	    CONTACT_FLAG_SMS		=> 0x100000,

 	MRIM_CS_ADD_CONTACT_ACK		=> 0x101A,
	    CONTACT_OPER_SUCCESS	=> 0,
	    CONTACT_OPER_ERROR 		=> 1,
	    CONTACT_OPER_INTERR 	=> 2,
	    CONTACT_OPER_INVALID_INFO 	=> 4,

 	MRIM_CS_MODIFY_CONTACT		=> 0x101B,
 	MRIM_CS_MODIFY_CONTACT_ACK	=> 0x101C,

 	MRIM_CS_CONTACT_LIST2		=> 0x1037,

	MRIM_CS_SMS 			=> 0x1039,
	MRIM_CS_SMS_ACK 		=> 0x1040,

	MRIM_UA 			=> 'MRA 5.0 (build 2094);',

	MRIM_ADDR			=> 'mrim.mail.ru',
	MRIM_PORT			=> 2042
};

$|++;


	############################
	## Основные методы класса ##
	############################


sub new {

	my ($pkgname, $login, $password, $debug) = @_;

	my $self = {};

	$self->{_seq_real} = 1;
	$self->{_debug} = $debug;

	bless $self;

	## получаем хост и порт:

	my $sock1 = IO::Socket::INET->new(

		PeerAddr  => MRIM_ADDR,
		PeerPort  => MRIM_PORT,
		PeerProto => 'tcp', 
		TimeOut   => 5 );

	if (!defined $sock1) {

		_debug($self, 'error: can\'t connect to mrim.mail.ru');
		return 0;
	}

	$sock1->recv(my $answ, 18);
	close $sock1;
	chomp $answ;

   	my ($host, $port) = split /:/,  $answ;	

	## коннектимся на полученный хост:

	$self->{_sock} = IO::Socket::INET->new(

  		PeerAddr  => $host,
		PeerPort  => $port,
 	 	PeerProto => 'tcp',
		TimeOut   => 5 );

	if (!defined $self->{_sock}) {

		_debug($self, "error: can\'t connect to $host:$port");
		return 0;
	}

	## посылаем пакет HELLO:

	$self->{_sock}->send(_make_mrim_packet($self, MRIM_CS_HELLO));

	_recv_packet($self);

	## логинимся:

	my $data = _lps($login) 
		 . _lps($password) 
		 . pack('L', STATUS_OFFLINE) 
		 . _lps(MRIM_UA);

	$self->{_sock}->send(_make_mrim_packet($self, MRIM_CS_LOGIN2, $data));
	
	my ($msg, $data_rcv) = _recv_packet($self);

	if ($msg != MRIM_CS_LOGIN_ACK) {

		_debug($self, "auth error: $data_rcv");
		return 0;
	}
	
	return $self;
}



sub send_sms {

	my ($self, $phone, $sms_text) = @_;

	my $data = pack('L', 0) 
		 . _lps($phone) 
		 . _lps($sms_text);

	$self->{_sock}->send(_make_mrim_packet($self, MRIM_CS_SMS, $data));

	my ($msg, $data_rcv) = _recv_packet($self);

	return(unpack('L', $data_rcv));
}



sub add_contact {

	my ($self, $name, $phone) = @_;

	my $data = pack('L2', CONTACT_FLAG_SMS, 0x67) 
		 . _lps('phone')
		 . _lps($name)
		 . _lps($phone)
		 . pack('L', 0);

	$self->{_sock}->send(_make_mrim_packet($self, MRIM_CS_ADD_CONTACT, $data));
	
	my ($msg, $data_rcv) = _recv_packet($self);

	my ($status, $cid) = unpack('L2', $data_rcv);

	if ($status == CONTACT_OPER_SUCCESS) { return $cid }

	elsif ($status == CONTACT_OPER_ERROR) {
		_debug($self, 'add_contact error: incorrect contact data'); 
	}
	elsif ($status == CONTACT_OPER_INTERR) { 
		_debug($self, 'add_contact error: internal server error');
	}
	elsif ($status == CONTACT_OPER_INVALID_INFO) { 
		_debug($self, 'add_contact error: incorrect username');
	}

	return 0;
}



sub delete_contact {

	my ($self, $contact_id, $name, $phone) = @_;

	my $flag = (CONTACT_FLAG_SMS | CONTACT_FLAG_REMOVED);

	my $data = pack("L3", $contact_id, $flag, 0x67) 
		 . _lps('phone') 
		 . _lps($name) 
		 . _lps($phone);

	$self->{_sock}->send(_make_mrim_packet($self, MRIM_CS_MODIFY_CONTACT, $data));

	my ($msg, $data_rcv) = _recv_packet($self);

	my $status = unpack('L', $data_rcv);

	if ($status == CONTACT_OPER_SUCCESS) { return 1 }

	elsif ($status == CONTACT_OPER_ERROR) {
		_debug($self, 'delete_contact error: incorrect contact data'); 
	}
	elsif ($status == CONTACT_OPER_INTERR) { 
		_debug($self, 'delete_contact error: internal server error');
	}
	elsif ($status == CONTACT_OPER_INVALID_INFO) { 
		_debug($self, 'delete_contact error: incorrect username');
	}

	return 0;
}



sub ping {

	my $self = shift;

	$self->{_sock}->send(_make_mrim_packet($self, MRIM_CS_PING));

	_recv_packet($self);

	return 1;
}



sub close {

	my $self = shift;

	$self->{_sock}->close;

	return 1;
}



	#############################
	## Приватные методы класса ##
	#############################


## создание пакета:

sub _make_mrim_packet {

	my ($self, $msg, $data) = @_;

	my $dlen = 0;
	$dlen = length($data) if $data;

	my $mrim_packet = pack('L5', CS_MAGIC, PROTO_VERSION, 
				++$self->{_seq_real}, $msg, $dlen) 
			. pack('L', 0) x 6;

	$mrim_packet .= $data if $data;

	return $mrim_packet;
}


## LPS

sub _lps { return pack('L', length $_[0]) . $_[0]; }


## получение пакета c текущим значением seq_real:

sub _recv_packet {	

	my ($self) = shift;

	while (1) {

		$self->{_sock}->recv(my $ack, 44);

		my ($magic, $proto, $seq, $msg, $dlen, @other) = unpack('L11', $ack);

		my $data;

		$self->{_sock}->recv($data, $dlen) if $dlen;
	
		return($msg, $data) if ($seq == $self->{_seq_real});
	}
}


## вывод отладочной информации:

sub _debug {

	my ($self, $msg) = @_;

	print "$msg\n" if $self->{_debug};
}


return 1;