# haiku.pm - the Y(aho)o!Sucker project
#
# Version: Prototype 23a
#
# Copyright Dirk Diggler & Som One 1981-2002. All rides reserved.
# Coded by Som One and Pierrot Lunaire (French version)
# Redistribution and use, with or without modification,
# is permitted in the sense of GDWYWL
# (GeneralDoWhateverYouWantLicense)
# -z3r0-

# haiku.pm contains some code heavily inspired by webbiff 1.2
# Copyleft (C) 2001 Zhaohui Yang  (jyang_1997@yahoo.com)
# See the comments in Check4NewMail sub for more details.
# Check http://freshmeat.net for detail on webbiff project

# CREDITS!
# ========
# Please note that I would hardly be able to create haiku.pm without
# consulting:
# 	Mr Venkat Mani
#	venky_dude@yahoo.com
#	http://www.venkydude.com
# Thanks his article on YMSG Protocol 9 that can be found
# on http://www.venkydude.com/articles/yahoo.htm and thanks to him
# for providing me with the C source code of his venky.dll for windoze.
# The GET_YO_STRINGS sub is basicaly his code rewritten by me in Perl.

package YoFastMess; 

use strict;
use IO::Socket;
use Digest::MD5;
use MIME::Base64;

################
# Check4NewMail
#############

# Subroutine Check4NewMail connects to Yahoo Messenger server 
# and returns a possible number of new incoming messages.

sub Check4NewMail {
my $username = shift;
my $crypt_hash = shift;				# FASTPASS1
my $password_hash = shift;			# FASTPASS2
my $scam = length($username);
my $separator = "\xC0\x80";			# standart YMSG separator

#########
# CONNECT CONFIGURATION

my $pop_host = "cs.yahoo.com";
my $pop_port = "5050";

# END CONFIG
#########

# Now, because there are usualy some bad login(s) (my knowledge of the Yahoo Messenger
# protocol 9 isn't perfect) we must allow retry if there is a login failure. However,
# to filter out possible REAL bad username/password, I've decided to introduce a login
# timeout ($retry_max)...
my $retry_count = 0;
my $retry_max = 15;

# The RETRY starts here...
RETRY:
$retry_count++;

# Body of the first "packet" sent to YMSG server
my @arr = qw(59 4D 53 47 09 00 00 00 00 00 57 00 00 00 00 00 00 00 00 31);

my $pokus;

my $cnt = 1;

# Complete the first "packet"...
foreach (@arr) {
  $_ = hex($_);
  if ($pokus) { $pokus = $pokus.chr($_) }
  else { $pokus = chr($_) }

  # Add the "packet" length when needed...
  $pokus = $pokus.chr($scam+5) if ($cnt == 9);
  $cnt++;
}

$pokus = $pokus.$separator.$username.$separator;

# Lets connect!!!
my $pop = IO::Socket::INET->new (Proto	=> "tcp",
			   PeerAddr	=> $pop_host,
			   PeerPort	=> $pop_port,
			   Reuse	=> 1)
or do {
	print "Can't connect to the Yahoo Messenger server! Skipping FastCheck...\n";
	return 1;
};

$pop->autoflush(1);

#print "step one\n";

# Send the first "packet" to YMSG server...
print $pop $pokus;

#print $pop chr(hex('C0')).chr(hex('80'));
#print $pop $username;
#print $pop chr(hex('C0')).chr(hex('80'));

$|=1;

my $byte;
my $i = 1;
my $strap_lenght = 20;

my $session_id;
my $challenge;

# print $scam."\n";

# Lets read what the YMSG server sends us back...
while ($i != $strap_lenght+1) {
  sysread($pop, $byte, 1);

  # Get information length...
  $strap_lenght = $strap_lenght + ord($byte) if ($i == 10);

  # Get session ID - important!
  if (($i > 16) && ($i<21)) {
  	if ($session_id) { $session_id = $session_id.$byte }
	else { $session_id = $byte }
  }
  
  # Get challenge hash - important!
  if (($i > (29+$scam)) && ($i < (29+$scam+24+1))) {
	if ($challenge) { $challenge = $challenge.$byte }
	else { $challenge = $byte }
  }

  $i++;
}

# Body of the second "packet"...
my @arr2 = qw(59 4D 53 47 09 00 00 00 00 00 54 00 00 00 0C 30 36 39 36 32 C0 80 31 C0 80 31 C0 80);

# Get the two hash strings needed for the second packet...
my $hashez = get_yo_strings($challenge,$username,$crypt_hash,$password_hash);
my $hash1 = $hashez->{"p_hash"};
my $hash2 = $hashez->{"c_hash"};

# print length($hash1)."\n";

$cnt = 1;
my $pokus2;

# Lets complete the second packet body...
foreach (@arr2) {
  $_ = hex($_);
  if ($pokus) { $pokus2 = $pokus2.chr($_) }
  else { $pokus = chr($_) }
  
  # Add the information length...
  $pokus2 = $pokus2.chr($scam+$scam+27+24+24) if ($cnt == 9);

  # Add the session ID...
  $pokus2 = $pokus2.$session_id if ($cnt == 15);

  # Add username...
  $pokus2 = $pokus2.$separator.$username.$separator if ($cnt == 16);

  # Add the first and second hash string...
  $pokus2 = $pokus2.$separator.$hash1.$separator if ($cnt == 17);
  $pokus2 = $pokus2.$separator.$hash2.$separator if ($cnt == 19);
  $cnt++;
}

# Add the username again...
$pokus2 = $pokus2.$username.$separator;

# Send the second "packet" to the YMSG server...
print $pop $pokus2;


###################
# PEASE NOTE:
################
# The following lines have been taken from:
#=================================================================
# webbiff 1.2: Check Yahoo! new email via Yahoo! Messenger protocol.
# Copyleft (C) 2001 Zhaohui Yang  (jyang_1997@yahoo.com)
#=================================================================
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2
#  of the License, or (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License along
#  with this program; if not, write to the Free Software Foundation, Inc.,
#  59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#
# (c) Copyleft, GNU License
#=================================================================
# Lots of modifications to the code stated above were made by
# Mr Dirk Diggler, Mr Som One and Monsieur Pierrot Lunaire.
# Modifications - All rides reserved 1996-2002. 
# Redistribution and use of modifications made to the original code, 
# with or without modification, is permitted in the sense of GDWYWL
# (GeneralDoWhateverYouWantLicense).
# Or if it's again GNU GPL to re-license the modified code, and if even 
# the modifications added exclusively by you must be re-issued under GPL
# then consider the next part being a GPLicensed code. Anyone ever really 
# read the GPL?! :-)
# -z3r0-



my $hasnum = 0;
my @r;
my $alert = 0;
my $key;
my $end;
my $mailnum;

    # Read what the server sends us back...
    while ( sysread($pop, $byte, 1) ) {
        push(@r, $byte);

        # field 20 indicates if the message contains count of new emails
	# if set to 9 - we have new mail information comming...
        if ($#r == 20)
        {
	  if ($byte == 9) { $hasnum = 1; }
	  else         { $hasnum = 0; }
        }

        # field 23-25 indicates # of new emails
        if ($#r == 25 && $hasnum == 1)
        {
            $mailnum = $r[$#r-2]. $r[$#r-1];
            $mailnum =~ s/[^0-9]//g;
            if ($mailnum > 0) { $alert = 1; }
            else              { $alert = 0; }

        }


        # End of response msg is indicated by \300\200\000
	if ($#r > 2) {
        if (ord($r[$#r - 2]) == 192 &&
            ord($r[$#r - 1]) == 128 &&
            ord($r[$#r    ]) == 0 )
        {
	    # We have new messages!!!
            if ($alert == 1) {
		$end = $mailnum + 1;
		last;
            }
            else
            {
		# lets check whether there is some more info arriving...
		$pop->blocking(0);
		
		# if not, return zero mails and finish...
		if (! (sysread($pop, $key, 1))) {
			$end = 1;
			last;
		}
		$pop->blocking(1);
            }
            undef(@r);

	    # the communication continues so we need to reuse the previously
	    # read value...
	    if ($key) {
		$r[@r] = $key;
		undef ($key);
	    }
        }
	}

    }

########
# END OF THE webbiff GNU GPL CODE
###########

close($pop);

# Now something really awfull :-) Sorry, but I was tooooooo lazy to change this! :-)
# If there was a login error (not necessarily something to be afraid of),
# reset all the variables and retry... until $retry_max
if (! $end) {
undef $hash1;
undef $hash2;
undef $challenge;
undef $pokus;
undef $session_id;
undef $pokus2;
undef $mailnum;
if ($retry_count == $retry_max) {
	print "Can't connect to the Yahoo Messenger server! Skipping FastCheck...\n";
	print "Perhaps your USERNAME/FASTPASS1/FASTPASS2 is wrong?\n";
	return 1;
}
goto "RETRY";
}

# Return a possible number of new messages
return ($end - 1);
}

################
# GET_YO_STRINGS
#############

# NO COMMENT FROM NOW ON - IT'S A REAL MESS - in most cases I don't know why you actually
# have to do that particular thing... I just know it works like this...

sub get_yo_strings {
my $challenge = shift;
my $username = shift;
my $crypt_hash = shift;
my $password_hash = shift;

my @seed = unpack("C*", $challenge);

my $sv = $seed[15];
my $checksum = $sv % 16;


SWITCH: {
	$checksum = $seed[1], last SWITCH if $checksum =~  /^(3|11)$/;
	$checksum = $seed[3], last SWITCH if $checksum =~ /^(4|12)$/;
	$checksum = $seed[7], last SWITCH if $checksum =~ /^(5|8|13|0)$/;
}

$checksum = $seed[$checksum % 16];

my $ordering = $sv % 8;

my $hash_string_p;
my $hash_string_c;

SWITCH2:{
  if ($ordering =~ /^(1|6)$/) {
	$hash_string_p = chr($checksum).$username.$challenge.$password_hash;
	$hash_string_c = chr($checksum).$username.$challenge.$crypt_hash;
	last SWITCH2;
  }
  elsif ($ordering =~ /^(2|7)$/) {
	$hash_string_p = chr($checksum).$challenge.$password_hash.$username;
	$hash_string_c = chr($checksum).$challenge.$crypt_hash.$username;
	last SWITCH2;
  }
  elsif ($ordering =~ /^(3|4)$/) {
	$hash_string_p = chr($checksum).$username.$password_hash.$challenge;
	$hash_string_c = chr($checksum).$username.$crypt_hash.$challenge;
	last SWITCH2;
  }
  elsif ($ordering =~ /^(0|5)$/) {
	$hash_string_p = chr($checksum).$password_hash.$username.$challenge;
	$hash_string_c = chr($checksum).$crypt_hash.$username.$challenge;
	last SWITCH2;
  }
}

my $ctx4 = Digest::MD5->new;
$ctx4->add($hash_string_p);
my $final = $ctx4->digest;

my $yo_string1 = encode_mac64($final);

$ctx4 = Digest::MD5->new;
$ctx4->add($hash_string_c);
$final = $ctx4->digest;

my $yo_string2 = encode_mac64($final);

my %yos = (
	"p_hash" => $yo_string1,
	"c_hash" => $yo_string2
);

return \%yos;
}

################
# ENCODE_MAC64
#############

sub encode_mac64 {
  my $what = shift;

  my $encoded = encode_base64($what);
  $encoded =~ s/\+/./g;
  $encoded =~ s/\//_/g;
  $encoded =~ s/=/-/g;

  chomp($encoded);
  return $encoded;
}

1; # End of it all
