#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

# Some initial part of the client-side Emule protocol
# implementation.
#
# Copyright (C) 2003/2004 Salvatore Sanfilippo
# Under the same license as Tcl/Tk 8.4
#
# This code is already usable to connect to another client IP/Port
# (port is usually 4662) and show it's username, server, ID,
# and if available the list of shared files.
#
# Note that I'll never finish this code, this was written when
# I was learning some initial Tcl and liked to play with
# binary stuff.

proc write {fd data} {
    puts -nonewline $fd $data
}

proc protostr proto {
    switch $proto {
	e3 {format eDonkey}
	c5 {format {eMule extensions}}
	d4 {format {eMule compressed}}
	default {format "Unknown ($proto)"}
    }
}

proc cmdstr cmd {
    switch $cmd {
	4b {format {View files answer}}
	4c {format {Hello answer}}
	4e {format {Message}}
	58 {format {File name request}}
	default {format "Unknown (0x$cmd)"}
    }
}

proc mtagstr mtag {
    switch $mtag {
	0 {format Undefined}
	1 {format Hash}
	2 {format String}
	3 {format DWord}
	4 {format Float}
	5 {format Bool}
	6 {format {Bool array}}
	7 {format Blob}
	default {format "Unknown ($mtag)"}
    }
}

proc stagstr stag {
    switch $stag {
	1 {format Name}
	2 {format {Size of file}}
	3 {format Type}
	4 {format Format}
	5 {format Collection}
	6 {format {Part Path}}
	7 {format {Part Hash}}
	8 {format Copied}
	9 {format {Gap start}}
	10 {format {Gap end}}
	11 {format Description}
	12 {format Ping}
	13 {format Fail}
	14 {format Preference}
	15 {format Port}
	16 {format Ip}
	17 {format Version}
	18 {format TempFile}
	19 {format Priority}
	20 {format Status}
	21 {format Availability}
	22 {format QTime}
	23 {format Parts}
	default {format "Unknown $stag"}
    }
}

# Start
if {$argc != 1 && $argc != 2} {
    puts stderr {Usage: edinfo <host> [port]}
    exit 1
}
if {$argc == 1} {lappend argv 4662}
foreach {targethost targetport} $argv break

proc readPacket {fd protovar lenvar pktvar} {
    upvar $protovar proto $lenvar len $pktvar pkt
    # Read the header
    set hdr [read $fd 5]
    puts "Header length: [string length $hdr]"
    binary scan $hdr H2i proto len
    puts "Protocol: $proto ([protostr $proto])"
    puts "Length  : $len bytes"

    # Read the actual packet
    set pkt [read $fd $len]
}

proc buildPacket data {
    set len [string length $data]
    append pkt "\xe3"; # protocol (eDonkey)
    append pkt [binary format i $len]
    append pkt $data
}

proc sendHelo fd {
    puts "> Helo"
    # Build the Hello request
    append hello "\x01"; # command (Hello)
    append hello "\x10"; # user hash size (16 bytes)
    append hello "\x24\x0f\xf8\x30\xdd\x4b\x4e\x50"; # userhash first 8 bytes
    append hello "\x56\x91\xac\xeb\xae\x52\x4c\x9e"; # userhash last 8 bytes 
    append hello "\xaa\xbb\x00\x00"; # user id = Our IP for High ID
    append hello "\x36\x12"; # our ports
    append hello "\x02\x00\x00\x00"; # tag count (must be <= 7)
    append hello "\x03\x01\x00\x11\x3c\x00\x00\x00"; # Version tag
    append hello "\x02\x01\x00\x01\x07\x00panzutu"; # Name tag
    append hello "\x42\x6F\x2B\x50"; # server IP (0 = none)
    append hello "\x92\x10"; # server port (0 = none)

    # Send the Hello request
    set hellopkt [buildPacket $hello]
    write $fd $hellopkt

    # Read the packet
    readPacket $fd proto len reply

    # Porcess the reply
    binary scan $reply "cH32H2H2H2H2sia*" cmd userhash x1 x2 x3 x4 port tagcount reply
    set userid [expr 0x$x4$x3$x2$x1]
    set ip [expr 0x$x1].[expr 0x$x2].[expr 0x$x3].[expr 0x$x4]
    if {$userid <= 0xFFFFFF} {set ip "Low ID"}
    puts "Command : [format %02x $cmd] ([cmdstr [format %02x $cmd]])"
    puts "UserHash: $userhash"
    puts "UserId  : $userid ($ip)"
    puts "Port    : $port"
    puts "Tags    : $tagcount"

    # Read the tags
    while {[incr tagcount -1] >= 0} {
	binary scan $reply "csa*" mtag taglen reply
	if {$taglen == 1} {
	    binary scan $reply "ca*" stag reply
	    set tagname [stagstr $stag]
	} else {
	    binary scan $reply [format "%s%s" a$taglen a*] tagname reply
	}
	puts -nonewline "  [mtagstr $mtag] $taglen $tagname: "
	switch $mtag {
	    2 {
		binary scan $reply "sa*" strlen reply
		append fmt "a$strlen" "a*"
		binary scan $reply $fmt str reply
		puts "$str ($strlen bytes)"
	    }
	    3 {
		binary scan $reply "H2H2H2H2a*" x1 x2 x3 x4 reply
		set dw [expr 0x$x4$x3$x2$x1]
		puts $dw
	    }
	    default {
		puts "Unable to handle this TAG"
		exit 1
	    }
	}
    }

    # Read Server and Port
    binary scan $reply "H2H2H2H2sa*" x1 x2 x3 x4 servport reply
    set ip [expr 0x$x1].[expr 0x$x2].[expr 0x$x3].[expr 0x$x4]
    puts "Server IP: $ip"
    puts "Serv Port: $servport"
    if {[string length $reply]} {
	puts -nonewline "WARNING: Spurious data at end of reply:"
	binary scan $reply H* spurious
	puts " \[$spurious\]"
    }
}

proc hexdump data {
    set bytesperline 16
    set idx 0
    set l [string length $data]
    while {$l} {
	if {$l < $bytesperline} {
	    set c $l
	} else {
	    set c $bytesperline
	}
	set hexrepr {}
	set asciirepr {}
	for {set i 0} {$i < $c} {incr i} {
	    binary scan $data "aa*" byte data
	    binary scan $byte "H2" hexbyte
	    append hexrepr "$hexbyte "
	    if {[string is print $byte]} {
		append asciirepr $byte
	    } else {
		append asciirepr .
	    }
	}
	puts [format "%08d: %-50.50s|%-18.18s|" $idx $hexrepr $asciirepr]
	incr l -$c
	incr idx $c
    }
}

proc showGenericReply fd {
    readPacket $fd proto len reply
    binary scan $reply "ca*" cmd reply
    puts "Command : [format %02x $cmd] ([cmdstr [format %02x $cmd]])"
    puts "Data dump follows:"
    hexdump $reply
}

proc sendViewFiles fd {
    puts "> View Files"
    # Build the View Files request
    append pkt "\x4a"; # command (View Files)
    set hpkt [buildPacket $pkt]
    write $fd $hpkt

    # Read the packet
    showGenericReply $fd
}

proc sendMessage {fd msg} {
    puts "> Message \"$msg\""
    append pkt "\x4e" [binary format "s" [string length $msg]] $msg
    set hpkt [buildPacket $pkt]
    write $fd $hpkt

    # Read the packet
    # showGenericReply $fd
}

proc sendFileStatusRequest {fd hash} {
    puts "> File Status Request"
    # Build the File Status Request
    append pkt "\x4f"; # command (File Request)
    append pkt $hash; # file hash
    set hpkt [buildPacket $pkt]
    write $fd $hpkt

    # Read the packet
    readPacket $fd proto len reply
    puts "File Satatus reply length $len"
}

proc sendFileNameRequest {fd hash} {
    puts "> File Name Request"
    # Build the Files Request request
    append pkt "\x58"; # command (File Request)
    append pkt $hash; # file hash
    # black magic string
    append pkt "\x4b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04"

    # Send the request
    set hpkt [buildPacket $pkt]
    write $fd $hpkt

    # Read the packet
    readPacket $fd proto len reply
    puts "File Name Request reply length $len"
}

set fd [socket $targethost $targetport]
fconfigure $fd -encoding binary -buffering none
sendHelo $fd
#sendMessage $fd Hello
sendViewFiles $fd
#sendFileStatusRequest $fd 0123456789012345
close $fd

# vim: filetype=tcl softtabstop=4 shiftwidth=4