sub sendRaw($$$) {
    use constant IPPROTO_RAW => 255;
    my ($destination, $dport, $packet) = @_;
    eval {
        socket(SOCKET, PF_INET, SOCK_RAW, IPPROTO_RAW);
        my $paddr = sockaddr_in($dport, inet_aton($destination));
        send(SOCKET, $packet, 0, $paddr);
    };
    if ($@) {
        print "Error occured: $@";
    }
}

sub assembleRawUdp($$$$$) {
    my ($destination, $dport, $source, $sport, $data) = @_;
    #############
    # IP HEADER #
    #############
    my $packet = undef;
    $packet .= pack('C', 0x45); # Version + IHL
    $packet .= pack('H2', '00'); # Type of Service
    $packet .= pack('n', 28 + length($data)); # Total length
    $packet .= pack('n', 0); # Identification (not very good one)
    $packet .= pack('H4', '4000'); # Flags + fragment offset
    $packet .= pack('C', 0x40); # TTL
    $packet .= pack('C', 0x11); # Protocol (udp)
    $packet .= pack('n', 0); # Header checksum
    $packet .= inet_aton($source); # Source Ip
    $packet .= inet_aton($destination); # Destination Ip

    ##############
    # UDP HEADER #
    ##############
    $packet .= pack('n', $sport); # Source port
    $packet .= pack('n', $dport); # Destination port
    $packet .= pack('n', 8 + length($data)); # Length
    $packet .= pack('H4', '0000'); # Checksum

    ################
    # Data payload #
    ################
    $packet .= $data;

    return $packet;
}

1