#!/usr/bin/perl -w

# Auteur   : Benoit PAPILLAULT
# Creation : 27/05/2000

# Objectifs : realiser un clone de Yahoo messenger!

# 05/06/2000: update YahooID used for displaying our messages. We use
# $active_id and not $msg_id

# 07/06/2000: updated window position and behaviour (via pack() options)
# 08/06/2000: added online/offline message (and customizable AWAY messages).
# 11/06/2000: parsing buddy list.
# 14/06/2000: YahooID is case insensitive.
# 15/06/2000: added log file for main window
# 16/06/2000: added log file for all chat window to ~/yahoo/chat-$YahooID-16-06-2000.txt
#             + checking lowercase.
# 25/06/2000: handle multiline offline message
#             + loading previous chat file + new email flag.
#             + icons for state (offline, online).
# 28/06/2000: put under CVS.
# 29/06/2000: added support for basic new Yahoo Messenger! protocol, we
#             call it v2 'YMSG' and the previous one v1 'YH001'
# 19/07/2000: better message parsing. added status message display
#             and menu to change status (even custom)

# Menus:
# Edit -> Friends/Groups -> http://edit.my.yahoo.com/config/set_buddylist
#                           http://edit.yahoo.com/config/set_buddylist
# Edit -> My Profiles -> http://edit.my.yahoo.com/config/edit_identity
# Edit -> Account/Password -> http://edit.my.yahoo.com/config/eval_profile
# Find Friends -> http://search.profiles.yahoo.com/?.src=pg
# More -> View a Profile -> http://profiles.yahoo.com/benoit_test
# More -> Search Profiles -> http://search.profiles.yahoo.com?.src=pg/
# More -> Invite a friend -> http://edit.my.yahoo.com/config/invite_bd
# More -> Help -> http://a2.msg.yahoo.com/jpager/help/
# Sending a msg: http://edit.yahoo.com/config/send_webmesg?.target=benoit_test

# Adding a new user:
# ---> US:
# http://edit.yahoo.com/config/eval_register?.intl=us&new=1&.done=http%3a//edit.yahoo.com/config/eval_profile%3f.src=pg%26.done=http%3a//messenger.yahoo.com/messenger/&.src=pg&partner=&promo=&.last=
# ---> Non US:
# http://edit.yahoo.com/config/eval_register?.intl_flag=1&.accept=&.create=&.demog=&.done=http%3a//edit.yahoo.com/config/eval_profile%3f.src=pg%26.done=http%3a//messenger.yahoo.com/messenger/&.fam=&.i=&.kidDone=&.last=&.src=pg&ck=&partner=&promo=&ym_agreed=&.intl=us&.toIntl=1
# Deleting an existing user:
# http://edit.yahoo.com/config/remove_user?k=IXtKZWJ5eH5zaHNidTiOIXlKZDIzYzF1ZHhifXp%2bZiF1Sk4xNjYwM04wMSFzSndg

use Tk;
use Tk::Tree;
use Tk::Text;
use Tk::Dialog;
use Socket;
use IO::Handle;
use FileHandle;
use Tk::DialogBox;

# You need to install Crypt/PasswdMD5 and MD5
# I use : Crypt-PasswdMD5-1.0.tar.gz from Luis Munoz   
#   and : MD5-1.7.tar.gz             from Neil Winton 
use Crypt::PasswdMD5;
 
# configuration part :

$pager_host_v1 = "jpager.yahoo.com";
$pager_host_v2 = 'cs.yahoo.com';
$pager_port    = 5050;
$nick       = "benoit_test";
$password   = "toto2000";
$debug_sendmsg = 0;
$yahoodir   = "${ENV{'HOME'}}/yahoo";
$version    = "28/06/2000";
$usev1      = 0;

# global variables:

# $compteur is used for internal log files (currently HTTP request &
# answers)
$compteur = 0;

# @cookies is used for storing HTTP cookies sent by yahoo.com

# %grouplist is used for storing group name of each user.
# key is the user name. $grouplist{$member} = $group.

# %windowlist is used for finding chat windows, key is "$active_id,$msg_id".
# Values is a reference to a list containing ($text, $entry, $log) which are
# respectively: chat text widget, text entry widget and log file handle.

# $tree is a widget tree. current branch names are:
# .$group.$yahooid

$YAHOO_SERVICE_LOGON        =  1;
$YAHOO_SERVICE_LOGOFF       =  2;
$YAHOO_SERVICE_ISAWAY       =  3;
$YAHOO_SERVICE_ISBACK       =  4;
$YAHOO_SERVICE_MESSAGE	    =  6;
$YAHOO_SERVICE_NEWMAIL      = 11;
$YAHOO_SERVICE_PING         = 18;

$YAHOO1_PACKET_HEADER_SIZE   = 104;
$YAHOO2_PACKET_HEADER_SIZE   = 20;

# print_list(@list) : for debugging, display all elements of
# a list

sub print_list {
    my (@list) = @_;
    my ($el);

    foreach $el (@list) {
	print "el=$el\n";
    }
}

# nothing : does nothing

sub nothing {
    print "nothing has been done\n";
    Tk->break;
}

# tree_set ($tree, $branch, $text, $image)
# set $branch's text to $text. $tree is a valid tree.
# all intermediate branches are checked and create if necessary.

sub tree_set {
    my ($tree, $branch, $text, $image) = @_;
    my (@list,$i,$sb);

    print "branch=$branch, text=$text\n";

    @list = split /\./, $branch;

    for ($i=0;$i<@list;$i++) {
	if ($i == 0) {
	    $sb = $list[$i];
	    next;
	} else {
	    $sb .= "." . $list[$i];
	}

	if ($tree->info('exists',$sb)) {
	    if ($i == @list -1) {
		$tree->entryconfigure($sb,
				      -text => $text,
				      -image => $image);
	    }
	} else {
#	    print "tree_add: sb=$sb, text=$text\n";
	    if ($i == @list -1) {
		$tree->add($sb,
			   -text => $text,
#			   -text => $list[$i],
			   -image => $image);
	    } else {
		$tree->add($sb, -text => $list[$i]);
	    }
	    $tree->autosetmode();
	}
    }
}

# display ($str) : display a string in the main window
# should only be called when $maintext is valid

sub display {
    my ($str) = @_;

    $str = localtime() . ': ' . $str;

# display on the main window, we first check that the main window still exists.
    if (Exists ($maintext)) {
	$maintext->insert('end',$str);
	$maintext->see('end');
    }

# save into log file
    print MAINTEXTLOG $str;
}

# display_msg ($text, $msg, $raise) : display a string in the specified 
# message window and raise the focus

sub display_msg {
    my ($rlist,$msg,$raise, $t) = @_;
    my ($text, $entry, $log);

    $text  = $rlist->[0];
    $entry = $rlist->[1];
    $log   = $rlist->[2];

    if (!defined($t)) {
	$t = time();
    }

    my @now = localtime ($t);
    my ( $mday, $mon, $year, $hour, $min, $sec) = ($now[3],
						   $now[4]+1,
						   $now[5]+1900,
						   $now[2],
						   $now[1],
						   $now[0]);

    my $content = sprintf("[%02d/%02d/%04d %02d:%02d:%02d] ",
			  $mday,$mon,$year,$hour,$min,$sec);
		
    $content .= $msg . "\n";
    $text->insert('end',$content);
    $text->see('end');
    if ($raise) {
	$entry->parent()->raise();
	$entry->focus();
    }

    print $log $content;
}  

# parse_output (SOCKET)

sub parse_output {
    my ($socket) = @_;

    $compteur ++;
    $log = "answer.${compteur}.txt";
#    print "Saving to $log\n";
    open LOG, ">$log";

    display "Parsing answer from yahoo ...\n";

    while (<$socket>) {
	print LOG $_;

	if (/Set-Cookie: ([^;]*)/) {
	    print "Cookie detected $1\n";
	    push @cookies, $1;
	}
	if (/Location: ([^\r]*)/) {
	    print "New location ='" .  $1 . "'\n";
#	    $location = $1;
	}
    }

    close LOG;
}

# @html = http_get ( $host, $port, $url, \@html )
# returns 1 is answer has been correctly received, 0 else.

sub http_get {
    my ($host, $port, $url, $rhtml) = @_;
    my ($ipaddr, $sin, $oldfh, $msg, $log);

    display "GET http://$host:$port$url\n";

    socket (SOCKET,PF_INET,SOCK_STREAM,0);
    $ipaddr = gethostbyname($host);
    if (!defined ($ipaddr)) {
	display "Can't get IP of $host: $!\n";
	return 0;
    }

    $sin = sockaddr_in($port,$ipaddr);
    if (!connect (SOCKET,$sin)) {
	display "Can't connect to $host: $!\n";
	return 0;
    }

    $oldfh = select(SOCKET);
    $| = 1;
    select($oldfh);

    $msg = "GET $url HTTP/1.0\r\n";
    $msg .= "User-Agent: Mozilla/4.0\r\n";
    if (@cookies) {
	$msg .= "Cookie:";
	foreach $cookie (@cookies) {
	    $msg .= " $cookie";
	}
	$msg .= "\r\n";
    }
    $msg .= "\r\n";

# saving request 
    $compteur ++;
    $log = "get.${compteur}.txt";
    open LOG, ">$log";
    print LOG $msg;
    close LOG;

# sending request
    print SOCKET $msg;

# parsing answer
    while (<SOCKET>) {
	if (/Set-Cookie: ([^;]*)/) {
	    push @cookies, $1;
	    print "Cookie detected $1\n";
	}
	if ($_ eq "\r\n") {
	    last ;
	}
    }

    @{$rhtml} = <SOCKET>;
    close (SOCKET);
    return 1;
}

# http_post ( $host, $port, $url, $content, \@html)
# returns 1 if answer is correctly received, 0 else.

sub http_post {
    my ($host, $port, $url, $content, $rhtml) = @_;
    my ($ipaddr, $sin, $oldfh, $msg, $len, $log);

    display "POST http://$host:$port$url\n";

    socket (SOCKET,PF_INET,SOCK_STREAM,0);
    $ipaddr = gethostbyname($host);
    if (!defined ($ipaddr)) {
	display "Can't get IP of $host: $!\n";
	return 0;
    }

    $sin = sockaddr_in($port,$ipaddr);
    if (!connect (SOCKET,$sin)) {
	display "Can't connect to $host: $!\n";
	return 0;
    }

    $oldfh = select(SOCKET);
    $| = 1;
    select($oldfh);

    $msg = "POST $url HTTP/1.0\r\n";
    $msg .= "User-Agent: Mozilla/4.0\r\n";
    if (@cookies) {
	$msg .= "Cookie:";
	foreach $cookie (@cookies) {
	    $msg .= " $cookie";
	}
	$msg .= "\r\n";
    }
    $msg .= "Content-type: application/x-www-form-urlencoded\r\n";
    $len = length ($content);
    $msg .= "Content-length: $len\r\n";
    $msg .= "\r\n";
    $msg .= $content;

# saving request
    $compteur ++;
    $log = "post.${compteur}.txt";
    open LOG, ">$log";
    print LOG $msg;
    close LOG;

# sending request
    print SOCKET $msg;

# parsing answer
    while (<SOCKET>) {
	if (/Set-Cookie: ([^;]*)/) {
	    push @cookies, $1;
	    print "Cookie detected $1\n";
	}
	if ($_ eq "\r\n") {
	    last;
	}
    }

    @{$rhtml} = <SOCKET>;
    close SOCKET;
    return 1;
}

# parse_buddylist (@html);

sub parse_buddylist {
    my (@html) = @_;
    my ($i, $line, $group, $member, $el);

    for ($i=0;$i<@html;$i++) {
	$line = $html[$i];
	if ($line =~ /BEGIN BUDDYLIST/) {
	    for ($i++;$i<@html;$i++) {
		$line = $html[$i];
		if ($line =~ /([^:]*):(.*)/) {
		    $group = $1;
		    foreach $member (split /,/, $2) {
			$grouplist{lc $member} = $group;
		    }
		}
		if ($line =~ /END BUDDYLIST/) {
		    last;
		}
	    }
	}
	
	if ($line =~ /BEGIN IGNORELIST/) {
	    for ($i++;$i<@html;$i++){
		$line = $html[$i];

# to be completed : parsing ignore list

		if ($line =~ /END IGNORELIST/) {
		    last;
		}
	    }
	}

	if ($line =~ /BEGIN IDENTITIES/) {
	    for ($i++;$i<@html;$i++) {
		$line = $html[$i];

		if ($line =~ /END IDENTITIES/) {
		    last;
		}

#		@identities = split /,/, $line;
	    }
	}

	if (/Mail=(.*)/) {
	    print "Mail flag is $1\n";
	}

	if (/Login=(.*)/) {
	    print "Using YahooID=$1\n";
	}
    }
}

# yahoo1_login($login , $passwd)

sub yahoo1_login {
    my ($login, $passwd) = @_;
    my ($content, @html);

    display "Trying to login as $login ...\n";

#    $content = "login=$login&passwd=$passwd";
#    http_post("jpager.yahoo.com",80,"/config/login",$content);

    $content = ".tries=1&.src=my&.last=&promo=&.intl=us&.bypass=&.partner=" .
	".chkP=Y&.done=http%3a///config/eval_profile&login=${login}" .
	    "&passwd=${passwd}";

# Le POST retourne les cookies B, Y et T.

    if (!http_post("login.yahoo.com",80,"/config/login",$content, \@html)) {
	return ;
    }
    print "html=@html\n";

#    http_get ("login.yahoo.com",80,
#	      "/config/verify?.done=http%3a///config/eval_profile");
#    http_get ("login.yahoo.com",80,"/config/eval_profile");
#    http_get ("edit.yahoo.com", 80,"/config/eval_profile");
    if (http_get ("jpager.yahoo.com",80,
		  "/config/get_buddylist?.src=bl", \@html)) {
#	print "buddylist=@html\n";
	parse_buddylist (@html);
    }
}

# get_login_page()

sub get_login_page {
#    http_get ("edit.europe.yahoo.com",80,
#	      "/config/eval_profile?.done=http://messenger.yahoo.com/intl/fr");

# Toute requete met a jour le Cookie "B".
#    http_get("edit.yahoo.com",80,
#	     "/config/eval_profile");
}

# yahoo1_sendcmd ($service, $content)

sub yahoo1_sendcmd {
    my ($service, $content) = @_;

#  8: version "YPNS2.0\0"
#  4: len (little) "680400" = 1128
#  4: service (little)
#----
#  4: connection_id (little)
#  4: magic_id
#  4: client IP
#  4: ??? 1
#----
# 36: primary_id
# 36: current_id
# offset 104 ici.
# ...: content	

    $connection_id = 0;
    $magic_id      = 0;
    $client_ip     = 0;
    $flag          = "\x55\xaa\x55\x5a";

    $content = pack("a1024",$content);
#    print "content length = " . length($content) . "\n";

    $msg = "YPNS2.0\0";
    $msg .= pack("V",$YAHOO1_PACKET_HEADER_SIZE + length($content));
    $msg .= pack("V",$service);
    $msg .= pack("V",$connection_id);
    $msg .= pack("V",$magic_id);
    $msg .= pack("V",$client_ip);
    $msg .= $flag;
    $msg .= pack("Z36",$primary_id);
    $msg .= pack("Z36",$current_id);
    $msg .= $content;

    if ($debug_sendmsg) {
	print "*** sending :\n";
	print "  service=$service, connection_id=$connection_id\n";
	print "  magic_id=$magic_id, client_ip=$client_ip\n";
	print "  primary_id=$primary_id, current_id=$current_id\n";
    }
   
    print YAHOO $msg;
}

# yahoo2_sendcmd ($service, $flag, @content)
# $service : SHORT, $flag : LONG.

sub yahoo2_sendcmd {
    my ($service, $flag, @content) = @_;
    my ($msg, $content, $f, $connection_id);
    
    $content = join("\xc0\x80",@content);
    $content .= "\xc0\x80";

    $f = 0x06000000;
    $connection_id = 0x0;

    $msg = pack("a4VnnNN",'YMSG',$f,length($content),
		$service,$flag,$connection_id);
    $msg .= $content;

    print YAHOO $msg;
}

# yahoo1_cmd_logon
# a initialiser au prealable:
# $login_cookie, $nick

sub yahoo1_cmd_logon {

    $magic_id = 0;
    $content = $login_cookie . "\1" . $nick;
    yahoo1_sendcmd($YAHOO_SERVICE_LOGON,$content);

#    $content = "C=0\002F=0,P=0,H=0,S=0,W=0,O=0\002M=0,P=0,C=0,S=0";
#    yahoo1_sendcmd($YAHOO_SERVICE_PASSTHROUGH2,$nick,$content);
    display "Log on!\n";
}

# yahoo2_cmd_logon ($nick, $passwd)

sub yahoo2_cmd_logon {
    my ($nick, $passwd) = @_;
    my ($crypted);

    $crypted = unix_md5_crypt($passwd,'_2S43d5f');
#    print "crypted=$crypted\n";

    yahoo2_sendcmd ($YAHOO_SERVICE_LOGON,0x5a55aa55,
		    '0',$nick,'6',$crypted,'1',$nick);
}

# yahoo_cmd_ping ($content)
sub yahoo1_cmd_ping {
    my ($content) = @_;
    yahoo1_sendcmd($YAHOO_SERVICE_PING,$content);
}

# get_login_cookie:
# initialise la variable $login_cookie
# a partir de la liste @cookies
# return 1 if ok, else 0.

sub get_login_cookie {
    foreach (@cookies) {
	if (/Y=[^n]*n=([^&]*)/) {
	    $login_cookie = $1;
	    display "login_cookie=$login_cookie\n";
	    return 1;
	}
    }

    display "No Y cookie found: Invalid YahooID/Password?\n";
    return 0;
}

# handle_input ($entry, $key, $active_nick, $msg_nick)
# called by each KeyPress on chat windows
# $active_nick is the YahooID we are using in the chat.
# $msg_nick is the YahooID of the person we are chatting with.

sub handle_input {
    my ($entry, $key, $active_id, $msg_id ) = @_;
    my ($rlist);

    if ($key ne 'Return') {
	return ;
    }

#    print "+++ active_id=$active_id, msg_id=$msg_id\n";

    $str = $entry->get();
    $entry->delete(0,'end');


    if ($usev1) {
	$content = "$msg_id,$str";
	yahoo1_sendcmd($YAHOO_SERVICE_MESSAGE,$content);
    } else {
	yahoo2_sendcmd($YAHOO_SERVICE_MESSAGE,0x5a55aa56,
		       '1',$active_id,'5',$msg_id,'14',$str);
    }

    $rlist = get_chat_window($active_id, $msg_id);
    display_msg($rlist, "${active_id}: $str", 0);
}

# create_chat_window ($active_id, $msg_id)
# create a new MainWindow for a new chat. $active_id is the YahooID we are
# using in the chat and $msg_id is the other side. The window title is always
# "$active_id => $msg_id".
# returns a reference to the list ($text, $entry, $log)

sub create_chat_window {
    my ($active_id, $msg_id) = @_;
    my ($entry, $text, $log);
    my ($mw, @now, $jour, $mois, $annee, $rlist, $file);

    $mw = MainWindow->new();
    $mw->title ("$active_id <=> $msg_id");
    $entry = $mw->Entry();
    $text = $mw->Text();

    $entry->bind('<KeyPress>',
		 [\&handle_input, Ev('K'), $active_id, $msg_id ]);
    
    $entry->pack(-side  => 'bottom',
		 -fill  => 'x');
    $text->pack(-side   => 'top',
		-fill   => 'both',
		-expand => 1);

    @now = localtime();
    $jour  = $now[3];
    $mois  = $now[4]+1;
    $annee = $now[5]+1900;

# filename used to log chat messages
    $file = "chat-" . lc($msg_id) . "-${jour}-${mois}-${annee}.txt";
    
# load previous chat message from the file (so, up to previous midnight)
    if (open (CHATLOG,$file)) {
	while (<CHATLOG>) {
	    $text->insert('end',$_);
	}
	$text->see('end');
	close (CHATLOG);
    }
    
    $log = new FileHandle ();
    open($log, ">>$file");
    $log->autoflush(1);

    $rlist = [ $text, $entry, $log ];
    $windowlist{lc ($active_id) . ',' . lc($msg_id)} = $rlist;

    return $rlist;
}

# get_chat_window ( $active_id, $msg_id )
# find an existing or create a new chat window 
# $active_id : our active YahooID,
# $msg_id    : the YahooID the message comes from
# returns a list containing ($text, $entry, $log) 

sub get_chat_window {
    my ($active_id, $msg_id) = @_;
    my ($rlist, $text);

    $rlist = $windowlist{lc($active_id) . ',' . lc($msg_id)};
    if (!defined ($rlist)) {
	$rlist = create_chat_window ($active_id, $msg_id);
    } else {
# we test if the existing window has been destroyed (by closing it).
	$text = $rlist->[0];
	if (! Exists ($text)) {
	    close ($rlist->[2]);
	    $rlist = create_chat_window ($active_id, $msg_id);
	}
    }

    return $rlist;
}

# set_state_v1 ($list[0], $list[1], $list[2], $list[4], $list[5])

sub set_state_v1 {
    my ($yahooid, $state, $msg, $flag1, $flag2) = @_;
    my ($connected, $b, $t, $img);

    if ($state == 99) {
	$connected = $flag2;
	chop $msg;
    } else {
	$connected = $flag1;
    }

    set_state ($yahooid, $state, $msg, $connected);
}

# sub set_state ($yahooid, $state, $msg, $connected);

sub set_state {
    my ($yahooid, $state, $msg, $connected) = @_;

    print "set_state $yahooid, $state, $msg, $connected\n";

    if ($connected) {
	$t = $yahooid;
	$img = 'online';
	if ($state == 0) {
#	    $t .= "I'm available";
	} elsif ($state == 1) {
	    $t .= " (Be Right Back)";
	} elsif ($state == 2) {
	    $t .= " (Busy)";
	} elsif ($state == 3) {
	    $t .= " (Not at Home)";
	} elsif ($state == 4) {
	    $t .= " (Not at my Desk)";
	} elsif ($state == 5) {
	    $t .= " (Not in the Office)";
	} elsif ($state == 6) {
	    $t .= " (On the Phone)";
	} elsif ($state == 7) {
	    $t .= " (On vacation)";
	} elsif ($state == 8) {
	    $t .= " (Out to Lunch)";
	} elsif ($state == 9) {
	    $t .= " (Stepped Out)";
	} elsif ($state == 99) {
	    $t .= " ($msg)";
	} elsif ($state == 999) {
	    $t .= " (Idle)";
	} else {
	    $t .= " ($state)";
	}
    } else {
	$t = $yahooid;
	$img = 'offline';
    }
    
    display "$yahooid is $t\n";

    tree_set ($tree,".$grouplist{lc $yahooid}.$yahooid", $t, $img);
}

# yahoo1_parsepacket ($service, $flag, $nick1, $nick2, $content)
# parse a yahoo packet and returns 1 if parsing has been done correctly

sub yahoo1_parsepacket {
    my ($service, $flag, $nick1, $nick2, $content) = @_;
    my ($result) = 0;
    my (@list, $yahooid, $connected, $i);

    if ($service == $YAHOO_SERVICE_LOGON) {
	if ($flag == 0) {
	    $result = 1;
	    print "LOGON, flag 0, $content\n";
# parsing "2,benoit_papillault(0,75867732,0,1,0,0),benoit_test(0,759635F8,0,1,0,0)"

# for a later use in yahoo_sendcmd
	    $primary_id = $nick1;
	    $current_id = $nick2;

	    print "init: primary_id=$primary_id, current_id=$current_id\n";

	    @list = split /,|\(|\)/, $content;
	    $nb = $list[0];
	    for ($i=0;$i<$nb;$i++) {
		set_state_v1 ($list[1+8*$i],$list[2+8*$i],$list[3+8*$i],
			   $list[5+8*$i],$list[6+8*$i]);
	    }
	} elsif ($flag == 1) {
	    print "LOGON, flag 1, $content\n";
# parsing "benoit_papillault(0,7591CE02,0,1,0,0)"

	    $result = 1;
	    @list = split /,|\(|\)/, $content;
	    set_state_v1 ($list[0], $list[1], $list[2], $list[4], $list[5]);
	}
    } elsif ($service == $YAHOO_SERVICE_LOGOFF) {
	if ($flag == 1) {
	    print "LOGOFF, flag 1, $content\n";

	    $result = 1;
	    @list = split /,|\(|\)/, $content;
	    set_state_v1 ($list[0], $list[1], $list[2], $list[4], $list[5]);
	}
    } elsif ($service == $YAHOO_SERVICE_ISAWAY) {
	if ($flag == 1) {
	    print "ISAWAY, flag 1, $content\n";

# parsing 'benoit_test(99,au travail,6EC482A1,0,1,0,0)'
# parsing 'astarg(999,7AC00000,0,1,0,0)'
	    $result = 1;
	    @list = split /,|\(|\)/, $content;
	    set_state_v1 ($list[0], $list[1], $list[2], $list[4], $list[5]);
	}
    } elsif ($service == $YAHOO_SERVICE_ISBACK) {
	if ($flag == 1) {
	    print "ISBACK, flag 1, $content\n";

# parsing 'astarg(0,7AC00000,0,1,0,0)'

	    $result = 1;
	    @list = split /,|\(|\)/, $content;
	    set_state_v1 ($list[0], $list[1], $list[2], $list[4], $list[5]);
	}
    } elsif ($service == $YAHOO_SERVICE_MESSAGE) {
	if ($flag == 1) {
# parsing "benoit_papillault,,11"
	    if ($content =~ /([^,]*),,(.*)/) {
		$result = 1;

		$from_nick = $1;
		$to_nick   = $nick2;
		$msg       = $2;
		
#		display("from_nick=$from_nick, to_nick=$to_nick, msg=$msg\n");
		
		my ($rlist) = get_chat_window ($to_nick,$from_nick);
		display_msg ($rlist, "${from_nick}: ${msg}", 1);
	    }
	} elsif ($flag == 5) {
# message sent while we were offline
# ex: 6,6,benoit_test,benoit_papillault,959733371,zobiebiebie...

	    @list = split /\x01/, $content;
	    foreach $content (@list) {
		if ($content =~ /[^,]*,[^,]*,([^,]*),([^,]*),([^,]*),(.*)/) {
		    $result    =  1;
		    $to_nick   = $1;
		    $from_nick = $2;
		    $date      = $3;
		    $msg       = $4;
		    
		    my ($rlist) = get_chat_window ($to_nick,$from_nick);
		    display_msg ($rlist, "${from_nick}: ${msg}", 1, $date);
		}
	    }
	}
    } elsif ($service == $YAHOO_SERVICE_NEWMAIL) {
	if ($flag == 1) {
	    $result = 1;
	    display "You've got $content new email message(s)\n";
	}
    }

    return $result;
}

# yahoo2_parsepacket ($service, $flag, @list)
# warning: @list is always terminating by an empty element.

sub yahoo2_parsepacket {
    my ($service, $flag, @list) = @_;

    my ($nb, $i, $key, $val, %param);

    $nb = @list;
    for ($i=0;$i<$nb-1;$i += 2) {
	$key = $list[$i];
	$val = $list[$i + 1];
	print "$key => $val\n";
    }

    if ($service == $YAHOO_SERVICE_LOGON) {
	if ($flag == 0) {
# 0 benoit_test
# 1 benoit_test        8 2
# 7 benoit_papillault 10 0 11 75992E14 17 0 13 1
# 7 benoit_test       10 0 11 68D6FDD1 17 0 13 1
# --------------------------------------------------------------------
# 0 benoit_test
# 1 benoit_test        8 3
# 7 benoit_papillault 10 0 11      75992E14 17 0 13 1
# 7 benoit_ter        10 1 47 1 11 73CE4D4A 17 0 13 1
# 7 benoit_test       10 0 11      68DDA9BB 17 0 13 1
	    
	    $nb = @list;
	    for ($i=0;$i<$nb;$i += 2) {
		$key = $list[$i];
		$val = $list[$i+1];

# if $val is not defined, this is the end of the list, so ...
# if $key already exists, we must proceed too. And reset the %param hash
		
		if (!defined($val) || defined($param{$key})) {
		    set_state ( $param{'7'},$param{'10'},
				$param{'19'},$param{'13'});
		    display "$param{'7'} is already log on\n";
		    %param = ();
		}
		$param{$key} = $val;
	    }		    
	} elsif ($flag == 1) {
# 0 benoit_test 7 benoit_test 10 0 11 68D6FDD1 17 0 13 1
# 0 benoit_test 7 benoit_ter  10 0 11 64DD7508 17 0 13 1

	    $nb = @list;
	    for ($i=0;$i<$nb;$i += 2) {
		$key = $list[$i];
		$val = $list[$i+1];

		if (defined($val)) {
		    $param{$key} = $val;
		}
	    }

	    set_state ( $param{'7'},$param{'10'},
			$param{'19'},$param{'13'});
	    display "$param{'7'} logs on\n";
	}
    } elsif ($service == $YAHOO_SERVICE_ISAWAY) {
	if ($flag == 1) {
# 7 benoit_ter 10 6 47 1 11 73CE4D4A 17 0 13 1

	    $nb = @list;
	    for ($i=0;$i<$nb;$i += 2) {
		$key = $list[$i];
		$val = $list[$i+1];

		if (defined($val)) {
		    $param{$key} = $val;
		}
	    }

	    set_state ( $param{'7'},$param{'10'},
			$param{'19'},$param{'13'});
	    display "$param{'7'} is away\n";
	}
    } elsif ($service == $YAHOO_SERVICE_ISBACK) {
	if ($flag == 1) {
# 7 benoit_ter 10 0 11 73CE4D4A 17 0 13 1

	    $nb = @list;
	    for ($i=0;$i<$nb;$i += 2) {
		$key = $list[$i];
		$val = $list[$i+1];

		if (defined($val)) {
		    $param{$key} = $val;
		}
	    }

	    set_state ( $param{'7'},$param{'10'},
			$param{'19'},$param{'13'});
	    display "$param{'7'} is back\n";
	}
    } elsif ($service == $YAHOO_SERVICE_LOGOFF) {
	if ($flag == 1) {
# 7 benoit_ter 10 0 11 73C2252B 17 0 13 0
	    
	    $nb = @list;
	    for ($i=0;$i<$nb;$i += 2) {
		$key = $list[$i];
		$val = $list[$i+1];

		if (defined($val)) {
		    $param{$key} = $val;
		}
	    }

	    set_state ( $param{'7'},$param{'10'},
			$param{'19'},$param{'13'});
	    display "$param{'7'} logs off\n";
	}
    } elsif ($service == $YAHOO_SERVICE_MESSAGE) {
	if ($flag == 1) {
# 5 benoit_test 4 benoit_papillault 14 coucou
	    $nb = @list;
	    for ($i=0;$i<$nb;$i += 2) {
		$key = $list[$i];
		$val = $list[$i+1];

		if (defined($val)) {
		    $param{$key} = $val;
		}
	    }

	    my ($from_nick, $to_nick, $msg, $rlist);

	    $to_nick   = $param{'5'};
	    $from_nick = $param{'4'};
	    $msg       = $param{'14'};

	    $rlist = get_chat_window ($to_nick,$from_nick);
	    display_msg ($rlist, "${from_nick}: ${msg}", 1);
	}
    }
}

# yahoo1_getpacket : read one packet from Yahoo! server
# returns 1 if ok, else 0.

sub yahoo1_getpacket {
    my ($r,$version,$len,$service,$connection_id,
	$magic_id,$client_ip,$flag,$nick1,$nick2,
	$host,$content,$msg);

    $r = read(YAHOO,$s,$YAHOO1_PACKET_HEADER_SIZE);
#    print "r=$r\n";
    if ($r != $YAHOO1_PACKET_HEADER_SIZE) {
	print "failed to read yahoo packet:$r ($YAHOO1_PACKET_HEADER_SIZE)\n";
	$mw->fileevent(YAHOO,'readable','');
	return 0 ;
    }
    ( $version,
      $len,
      $service,
      $connection_id,
      $magic_id,
      $client_ip,
      $flag,
      $nick1,
      $nick2) = unpack("Z8VVVVZ4VZ36Z36",$s);

    if (length($client_ip) == 4) {
#	$host = gethostbyaddr($client_ip,AF_INET) or
	$host = inet_ntoa($client_ip);
    } else {
	$host = "unknwon";
    }

    $len -= $YAHOO1_PACKET_HEADER_SIZE;

    $r = read(YAHOO,$content,$len);
#    print "r=$r\n";
    if ($r != $len) {
	print "failed to read yahoo packet: $r ($len)\n";
	$mw->fileevent(YAHOO,'readable','');
	return 0 ;
    }

# $content is a null terminated string, we've got to
# remove a trailing null.

    chop $content;
    chop $version;

    $len = length ($content);
    $msg = "--> version=$version, service=$service, "
	. "connection_id=$connection_id, magic_id=$magic_id, client_ip=$host\n"
	. "    flag=$flag, nick1=$nick1, nick2=$nick2, len=$len\n"
	. "    content=$content\n";
    
    print PACKETLOG $msg;

    if (!yahoo1_parsepacket ($service, $flag, $nick1, $nick2, $content)) {
	display $msg;
    }

    return 1;
}

# callback yahoo2_getpacket ()

sub yahoo2_getpacket {
    my ($r, $s);

#    print "reading from YAHOO socket\n";
    $r = read(YAHOO,$s,$YAHOO2_PACKET_HEADER_SIZE);
    if ($r != $YAHOO2_PACKET_HEADER_SIZE) {
	print "failed to read yahoo packet: $r ($YAHOO2_PACKET_HEADER_SIZE)\n";
	$mw->fileevent(YAHOO,'readable','');
	return 0;
    }

# 4 : ASCII                : $version
# 4 : LONG (little endian) : $f
# 2 : SHORT (big endian)   : $len
# 2 : SHORT (big endian)   : $service
# 4 : LONG  (big endian)   : $flag
# 4 : LONG  (big endian)   : $connection_id

    my ($version , $f, $len, $service, $flag, $connection_id) = 
	unpack ("a4VnnNN",$s);

    print "version=$version, f=$f, len=$len, service=$service";
    print ", flag=$flag, connection_id=$connection_id\n";

    $r = read(YAHOO,$content,$len);
    if ($r != $len) {
	print "failed to read yahoo packet: $r ($len)\n";
	$mw->fileevent(YAHOO,'readable','');
	return 0 ;
    }

    my (@list);
    @list =  split /\xc0\x80/ , $content, 0;

#    my ($el);
#    print "content =";
#    foreach $el (@list) {
#	print " $el";
#    }
#    print "\n";

    yahoo2_parsepacket ($service, $flag, @list);

    return 1;
}

# stdin_getline ($line) : read the current line and interpret it

sub stdin_getline {
    my ($line) = @_;
    chomp $line ;
    if ($line =~ /ping (.*)/) {
	display "pinging $1\n";
	yahoo1_cmd_ping ($1) ;
    }

    if ($line =~ /start/) {
	yahoo1_start() ;
    }
    if ($line =~ /raw ([^ ]*) (.*)/) {
	if ($usev1) {
	    display "sending raw msg service=$1, content=$2\n";
	    yahoo1_sendcmd ($1,$2);
	} else {
	    my (@list);
	    @list = split / /, $2;
	    yahoo2_sendcmd($1,1,@list);
	}
    }
    if ($line =~ /logon (.*) (.*)/) {
	display "logon with Yahoo ID=$1 and cookie=$2\n";
	yahoo1_sendcmd ($YAHOO_SERVICE_LOGON,$2 . "\1" . $1);
    }
    if ($line =~ /chat (.*)/) {
	get_chat_window ($current_id, $1);
    }
    if ($line =~ /help/) {
	display "ping str\n";
	display "raw service content\n";
	display "logon YahooID cookie\n";
    }
}

# display_buddylist()
# use %grouplist, $tree

sub display_buddylist {
    my ($yahooid, $group);

    foreach $yahooid (keys %grouplist) {
	$group = $grouplist{$yahooid};
	tree_set ($tree, ".$group.$yahooid",$yahooid,'offline');
    }
}

# yahoo1_start

sub yahoo1_start {
#get_login_page ();
    yahoo1_login($nick,$password);
    get_login_cookie ();
    
    socket (YAHOO,PF_INET,SOCK_STREAM,0);
    $ipaddr = gethostbyname($pager_host_v1);
    if (!defined ($ipaddr)) {
	display "Can't get IP of $pager_host_v1: $!\n";
	return ;
    }
    $sin = sockaddr_in($pager_port,$ipaddr);
    if (!connect (YAHOO,$sin)) {
	display "Can't connect to $pager_host_v1: $!\n";
	return ;
    }
    
    YAHOO->autoflush(1);
    
    yahoo1_cmd_logon();

    $mw->fileevent(YAHOO,'readable', \& yahoo1_getpacket );

    display_buddylist ();
}

# yahoo2_start ($nick, $passwd)

sub yahoo2_start {
    my ($nick,$passwd) = @_;
    my ($ipaddr, @html);

    if (http_get ('msg.edit.yahoo.com',80,
		  "/config/ncclogin?.src=bl&login=$nick&passwd=$passwd&n=1",
		  \@html)) {
#	print "buddylist=@html\n";
	parse_buddylist (@html);
    }

    socket(YAHOO,PF_INET,SOCK_STREAM,0);
    $ipaddr = gethostbyname($pager_host_v2);
    if (!defined ($ipaddr)) {
	display "Can't get IP of ${pager_host_v2}: $!\n";
	return ;
    }
    $sin = sockaddr_in($pager_port,$ipaddr);
    if (!connect (YAHOO,$sin)) {
	display "Can't connect to ${pager_host_v2}: $!\n";
	return ;
    }
    
    YAHOO->autoflush(1);
    yahoo2_cmd_logon($nick,$passwd);
    $mw->fileevent(YAHOO,'readable', \& yahoo2_getpacket );

    display_buddylist ();
}

# ui_parse_string ($str) : parse a string typed by user

sub ui_parse_string {
    my ( $str ) = @_;

    display "typed text = '" , $str , "'\n";
    $c = substr $str,0,1;

    if ($c eq '/') {
	$cmd = substr $str,1;
	display"cmd=$cmd\n";

	stdin_getline($cmd);

	if ($cmd =~ /quit/) {
	    exit ;
	}
    }
}

# do_search : called by each KeyPress on Entry field

sub do_search {
    my ($entry, $key) = @_;

    if ($key ne 'Return') {
	return ;
    }

    $str = $entry->get();
    $entry->delete(0,'end');

    ui_parse_string($str);
}

# menu_about ($mw)

sub menu_about {
    my ($mw) = @_;
    my ($dialog);

    $dialog = $mw->Dialog(-title => 'About',
			  -text  => "Yahoo Messenger! by Benoit PAPILLAULT\n"
			          . "written in Perl/Tk, $version",
			  -default_button => 'ok',
			  -buttons => [ 'ok' ]);
#    $mw->update();
    $dialog->Show();
}

# menu_status ($mw);

sub menu_status {
    my ($mw) = @_;

    my ($d) = $mw->DialogBox(-title => 'Enter custom message',
			     -buttons => ['Ok', 'Cancel']);
    
    my ($frame) = $d->add('Frame');
    my ($label) = $frame->Label(-text => 'Custom status message :');
    my ($texte) = $frame->Entry();

    $label->pack(-side => 'left');
    $texte->pack(-side => 'left', -fill => 'x', -expand => 1);
    
    $frame->pack(-side => 'top', -fill => 'x');

    $texte->focus();

    if ($d->Show() eq 'Ok') {
	change_status('99', $texte->get ());
    }
}

# menu_test ($mw)

sub menu_test {
    my ($mw) = @_;

    $grouplist{'benoit_test'} = 'Test';
    $grouplist{'benoit_test_bis'} = 'Test';
    $grouplist{'astarg'} = 'Friends';
    $grouplist{'ycaille'} = 'Friends';
    $grouplist{'f_peyrude'} = 'Friends';
    $grouplist{'benoit_papillault'} = 'Friends';
    $grouplist{'coco_en_vacances'} = 'Friends';
    $grouplist{'musculus_fr'} = 'Barbot';
    $grouplist{'jardon_2000'} = 'Barbot';

    display_buddylist ();
}

# tree_command ($entryPath)
# called when the user double click in the tree window.
# used to create a chat window with s.o.

sub tree_command {
    my ($entry) = @_;
    my ($yahooid, $rlist, $input);

    if ($entry =~ /\.[^\.]*\.([^\.]*)/) {
	$yahooid = $1;
	if ($yahooid ne $current_id) {
	    $rlist = get_chat_window ($current_id, $yahooid);
	    $input = $rlist->[1];
	    $input->parent()->raise();
	    $input->focus();
	}
    }
}

# change_status ( $status, $msg);
# $msg is optional.

sub change_status {
    my ($status, $msg) = @_;

    print "change_status $status, $msg\n";

    if ($usev1) {
#	yahoo1_sendcmd ($YAHOO_SERVICE_ISAWAY, 
	print "Not implemented ...\n";
    } else {
	if ($status != 99) {
	    yahoo2_sendcmd ($YAHOO_SERVICE_ISAWAY,0,'10',$status);
	} else {
	    yahoo2_sendcmd ($YAHOO_SERVICE_ISAWAY,0,'10',$status,
			    '19',$msg);
	}
    }
}

# main

sub main {

    if (@ARGV == 2) {
	($nick,$password) = @ARGV;
    }

# initial value of $primary_id and $current_id
    $primary_id = $nick;
    $current_id = $nick;

    $mw = MainWindow->new(-title => 'Yahoo Messenger!');

    $frame = $mw->Frame(-relief => 'raised');

# add menus : 

    $menubutton1 = $frame->Menubutton(-text => 'File');
    $menu1 = $menubutton1->Menu(-tearoff => 'false');
    $menubutton1->configure(-menu => $menu1);
    $menu1->add('command',-label => 'Quit', -command => sub { exit; });

    $menubutton2 = $frame->Menubutton(-text => 'Help');
    $menu2 = $menubutton2->Menu(-tearoff => 'false');
    $menubutton2->configure(-menu => $menu2);
    $menu2->add('command',-label => 'About',-command => [ \&menu_about, $mw]);
    $menu2->add('command',-label => 'Test', -command => [ \&menu_test, $mw]);

    $menubutton3 = $frame->Menubutton(-text => 'Status');
    $menu3 = $menubutton3->Menu(-tearoff => 'false');
    $menubutton3->configure(-menu => $menu3);
    $menu3->add('command',-label => 'I\'m available',
		-command => [ \&change_status, 0 ]);
    $menu3->add('command',-label => 'Be Right Back',
		-command => [ \&change_status, 1 ]);
    $menu3->add('command',-label => 'Busy',
		-command => [ \&change_status, 2 ]);
    $menu3->add('command',-label => 'Not at Home',
		-command => [ \&change_status, 3 ]);
    $menu3->add('command',-label => 'Not at my Desk',
		-command => [ \&change_status, 4 ]);
    $menu3->add('command',-label => 'Not in the Office',
		-command => [ \&change_status, 5 ]);
    $menu3->add('command',-label => 'On the Phone',
		-command => [ \&change_status, 6 ]);
    $menu3->add('command',-label => 'On Vacation',
		-command => [ \&change_status, 7 ]);
    $menu3->add('command',-label => 'Out to Lunch',
		-command => [ \&change_status, 8 ]);
    $menu3->add('command',-label => 'Stepped Out',
		-command => [ \&change_status, 9 ]);
    $menu3->add('command',-label => 'Idle',
		-command => [ \&change_status, 999]);
    $menu3->add('command',-label => 'Custom ...',
		-command => [ \&menu_status, $mw ]);

# packing instructions for menus :
    $menubutton1->pack(-side => 'left');
    $menubutton3->pack(-side => 'left');
    $menubutton2->pack(-side => 'right');

    $tree = $mw->Scrolled('Tree',
			  -itemtype   => 'imagetext',
			  -separator  => '.',
			  -selectmode => 'browse',
			  -drawbranch => 'false',
			  -indent     => 2,
			  -command    => [ \& tree_command ]
			  );
    $tree->add(".");

    $maintext = $mw->Scrolled('Text',
			      -scrollbars => 'osw');
    $maintext->bind('<KeyPress>', \&nothing );

    $entry = $mw->Entry();
    $entry->bind('<KeyPress>', [ \&do_search, Ev('K') ]);
   
# packing instructions for the main window :

    $frame->pack(-side => 'top',
		 -fill => 'x');
    $tree->packAdjust(-side => 'left',
#		      -padx  => 20,
#		      -ipadx => 20,
		      -fill => 'y');
    $entry->pack(-side => 'bottom',
		 -fill => 'x');
    $maintext->pack(-fill   => 'both',
		    -expand => 1);
    
    $mw->update();
    
# loading GIF images from current directory
    
    $mw->Photo('online', -file => 'online.gif', -format => 'gif');
    $mw->Photo('offline',-file => 'offline.gif',-format => 'gif');
    
# opening main log file
    
    if (! -d $yahoodir) {
	
	mkdir($yahoodir, 0777);
    }
    chdir($yahoodir);
    
    $yahoolog   = lc "yahoo_${nick}.log";
    open (MAINTEXTLOG,">>$yahoolog");
    MAINTEXTLOG->autoflush(1);
    
    $yahoopkt   = lc "pkt_${nick}.log";
    open (PACKETLOG,  ">>$yahoopkt");
    PACKETLOG->autoflush(1);
    
# first log message
    display "Using YahooID $nick and password $password\n";

    if ($usev1) {
	yahoo1_start();
    } else {
	yahoo2_start($nick,$password);
    }
    MainLoop();
    
    display "exiting\n";
}

main();