#!/usr/bin/perl

# msnp_status.pl release 8
# Copyright (c) 2002-2005 TAKEDA Hiroyuki

use Digest::MD5 qw(md5 md5_hex md5_base64);
use FileHandle;
use Socket;
use Net::SSLeay qw(get_https post_https sslcat make_headers make_form);


### メッセージ送信しないならコメント化
use Jcode;
use CGI;
$q = new CGI; 
$message = $q->param('message');


###
$login_id = 'kusuli@hotmail.com'; # チェック用のアカウント
$passwd = '********'; # そのパスワード
$check_id = 'leiqunni@hotmail.com'; # チェックするアカウント


###
$Debug = 0;
$timeout = 2;


###
$ds = 'messenger.hotmail.com';
$port = '1863';

$| = 1;
$TrID = 0;


###
$socket = msnp_connect( $ds, $port );

snd_msg( $socket, "VER " . $TrID ++ . " MSNP8 CVR0 \r\n" );
get_msg( $socket, "^VER " );

snd_msg( $socket, "CVR " . $TrID ++ . " 0x0409 win 4.10 i386 MSNMSGR 5.0.0544 MSMSGS $login_id \r\n" );
get_msg( $socket, "^CVR " );

snd_msg( $socket, "USR " . $TrID ++ . " TWN I $login_id \r\n" );
$buff1 = get_msg( $socket, "^XFR " );

( $cmd, $trid, $xfr, $ns, $buff1 ) = split( / /, $buff1 );
( $ns, $port ) = split( /:/, $ns );

close( $socket );


###
$socket = msnp_connect( $ns, $port );

snd_msg( $socket, "VER " . $TrID ++ . " MSNP8 CVR0\r\n" );
get_msg( $socket, "^VER " );

snd_msg( $socket, "CVR " . $TrID ++ . " 0x0409 win 4.10 i386 MSNMSGR 5.0.0544 MSMSGS $login_id \r\n" );
get_msg( $socket, "^CVR " );

snd_msg( $socket, "USR " . $TrID ++ . " TWN I $login_id \r\n" );
$buff1 = get_msg( $socket, "^USR " );

( $cmd, $trid, $twn, $s, $param ) = split( / /, $buff1 );

$auth = "Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=$login_id,pwd=$passwd,$param";

( $page, $response, @headers ) = get_https( 'loginnet.passport.com', 443, '/login2.srf', make_headers( Authorization => $auth ) );

( $buff1, $buff2 ) = split( /,from-PP='/, join( '', @headers ) );
( $buff1, $buff2 ) = split( /',ru=http:/, $buff2 );

snd_msg( $socket, "USR " . $TrID ++ . " TWN S $buff1 \r\n" );
get_msg( $socket, "^USR " );

snd_msg( $socket, "SYN " . $TrID ++ . " 0\r\n" );
get_msg( $socket, "^SYN " );

snd_msg( $socket, "CHG " . $TrID ++ . " NLN\r\n" );
get_msg( $socket, "^CHG " );


###
eval {
	local $SIG{ALRM} = sub { die "timeout" };

	alarm $timeout;
	while ( 1 ) {
		$buff1 =  get_msg( $socket, '.*' );
	
		if ( $buff1 =~ /^ILN/ ) {
			( $iln, $trid, $status, $account, $name, $param ) = split( / /, $buff1 );
			if ( $status eq 'NLN' ) {
				if ( $account eq $check_id ) {
					status_img( 'online.gif' );
					last;
				}
			}
		}
	}
	alarm 0;
};

alarm 0;

if ( $@ ) {
	if ( $@ =~ /timeout/ ) {
		status_img( 'offline.gif' );
		exit;
	}
}


###
snd_msg( $socket, "XFR " . $TrID ++ . " SB \r\n" );
$buff1 = get_msg( $socket, "^XFR " );

( $xfr, $trid, $sb_, $sb, $cki, $auth )  = split( / /, $buff1 );
( $sb, $port )  = split( /:/, $sb );


$socket2 = msnp_connect( $sb, $port );

snd_msg( $socket2, "USR " . $TrID ++ . " $login_id $auth \r\n" );
get_msg( $socket2, "^USR " );

snd_msg( $socket2, "CAL " . $TrID ++ . " $check_id \r\n" );
get_msg( $socket2, "^JOI " );

$buff1 = "MSG " . $TrID ++ . " U ";
$buff2 = "MIME-Version: 1.0\r\n" .
	"Content-Type: text/plain; charset=UTF-8\r\n" .
	"X-MMS-IM-Format: FN=; EF=; CO=; CS=; PF=\r\n" .
	"\r\n" .
	"$ENV{'REMOTE_HOST'}\r\n$ENV{'REMOTE_ADDR'}\r\n$ENV{'HTTP_REFERER'}";

if ( $message ne '' ) {
	$message = jcode($message)->utf8;
	$buff2 = "MIME-Version: 1.0\r\n" .
		"Content-Type: text/plain; charset=UTF-8\r\n" .
		"X-MMS-IM-Format: FN=; EF=; CO=; CS=; PF=\r\n" .
		"\r\n" .
		$message;
}

$buff1 = $buff1 . length( $buff2 ) . "\r\n" . $buff2;

snd_msg( $socket2, $buff1 );
snd_msg( $socket2, "OUT \r\n" );

exit;


###
sub msnp_connect {
	my ( $sv, $port ) = @_;
	my $socket;
	my $ip = inet_aton( $sv );
	my $sockaddr = pack_sockaddr_in( $port, $ip );
	socket( $socket, PF_INET, SOCK_STREAM, 0 );
	connect( $socket, $sockaddr );
	autoflush $socket 1;
	return $socket;
}

### 古いperl用
#sub msnp_connect {
#	my ( $sv, $port ) = @_;
#	my $ip = inet_aton( $sv );
#	my $sockaddr = pack_sockaddr_in( $port, $ip );
#	socket( SOCKET, PF_INET, SOCK_STREAM, 0 );
#	connect( SOCKET, $sockaddr );
#	autoflush SOCKET 1;
#	return SOCKET;
#}

sub snd_msg {
	my ( $socket, $buff1 ) = @_;
	print $socket $buff1;
	print "TX: $buff1" if ( $Debug ) ;
}

sub get_msg {
	my ( $socket, $buff1 ) = @_;
	my $line;

	eval {
		local $SIG{ALRM} = sub { die "timeout" };

		alarm $timeout;
		while ( 1 ) {
			$line = <$socket>;
			print "RX: $line" if ( $Debug ) ;
			if ( $line =~ /$buff1/ ) { last; }
		}
		alarm 0;
	};

	alarm 0;

	if ( $@ ) {
		if ( $@ =~ /timeout/ ) {
			status_img( 'offline.gif' );
			exit;
		}
	}

	$line =~ s/[\r\n]//g;
	return $line;
}

sub status_img {
	my ( $buff1 ) = @_;
	my $buff2;

	print "Content-type: image/gif\n\n";
	open FILE, $buff1;
	while ( read( FILE, $buff2, 4096 ) ) { print $buff2; }
	close FILE;
}