#!/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=4Category InternetWeblinks : http://www.edonkey2000-france.com/
