package Slim::Networking::Discovery;

# $Id: Discovery.pm 28040 2009-08-04 13:17:54Z tom $

# Squeezebox Server Copyright 2001-2009 Logitech.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License, 
# version 2.

use strict;

use Slim::Utils::Log;
use Slim::Utils::Prefs;
use Slim::Utils::Misc;
use Slim::Utils::Network;

my $log = logger('network.protocol');

my $prefs = preferences('server');

=head1 NAME

Slim::Networking::Discovery

=head1 DESCRIPTION

This module implements a UDP discovery protocol, used by Squeezebox, SLIMP3 and Transporter hardware.

=head1 FUNCTIONS

=head2 serverHostname()

Return a 17 character hostname, suitable for display on a client device.

=cut

sub serverHostname {
	my $hostname = $prefs->get('libraryname');
	
	if (!$hostname) {
		$hostname = Slim::Utils::Network::hostName();

		# may return several lines of hostnames, just take the first.	
		$hostname =~ s/\n.*//;
	
		# may return a dotted name, just take the first part
		$hostname =~ s/\..*//;
	}
	
	# Bug 13217, replace Unicode quote with ASCII version (commonly used in Mac server name)
	$hostname =~ s/\x{2019}/'/g;
	
	# Hostname needs to be in ISO-8859-1 encoding to support the ip3k firmware font
	$hostname = Slim::Utils::Unicode::encode('iso-8859-1', $hostname);

	# just take the first 16 characters, since that's all the space we have 
	$hostname = substr $hostname, 0, 16;

	# pad it out to 17 characters total
	$hostname .= pack('C', 0) x (17 - (length $hostname));

	if ( main::INFOLOG && $log->is_info ) {
		$log->info(" calculated $hostname length: " . length($hostname));
	}

	return $hostname;
}

=head2 sayHello( $udpsock, $paddr )

Say hello to a client.

Send the client on the other end of the $udpsock a hello packet.

=cut

sub sayHello {
	my ($udpsock, $paddr) = @_;

	main::INFOLOG && $log->info(" Saying hello!");	

	$udpsock->send( 'h'. pack('C', 0) x 17, 0, $paddr);
}

=head2 gotDiscoveryRequest( $udpsock, $clientpaddr, $deviceid, $revision, $mac )

Respond to a discovery request from a client device, sending it the hostname we found.

=cut

sub gotDiscoveryRequest {
	my ($udpsock, $clientpaddr, $deviceid, $revision, $mac) = @_;

	$revision = join('.', int($revision / 16), ($revision % 16));

	main::INFOLOG && $log->info("gotDiscoveryRequest: deviceid = $deviceid, revision = $revision, MAC = $mac");

	my $response = undef;

	if ($deviceid == 1) {

		main::INFOLOG && $log->info("It's a SLIMP3 (note: firmware v2.2 always sends revision of 1.1).");

		$response = 'D'. pack('C', 0) x 17; 

	} elsif ($deviceid >= 2 || $deviceid <= 4) {  ## FIXME always true

		main::INFOLOG && $log->info("It's a Squeezebox");

		$response = 'D'. serverHostname(); 

	} else {

		main::INFOLOG && $log->info("Unknown device.");
	}

	$udpsock->send($response, 0, $clientpaddr);

	main::INFOLOG && $log->info("gotDiscoveryRequest: Sent discovery response.");
}

my %TLVhandlers = (
	# Requests
	'NAME' => sub { 
		return $prefs->get('libraryname') || Slim::Utils::Network::hostName()
	},											       # send full host name - no truncation
	'IPAD' => sub { $::httpaddr },                     # send ipaddress as a string only if it is set
	'JSON' => sub { $prefs->get('httpport') },         # send port as a string
	'VERS' => sub { $::VERSION },			   # send server version
	'UUID' => sub { $prefs->get('server_uuid') },	   # send server uuid
	# Info only
	'JVID' => sub { main::INFOLOG && $log->is_info && $log->info("Jive: " . join(':', unpack( 'H2H2H2H2H2H2', shift))); return undef; },
);

=head2 addTLVHandler( $hash )

Add entries to tlv handler in format { $key => $handler }

=cut

sub addTLVHandler {
	my $hash = shift;

	for my $key (keys %$hash) {
		$TLVhandlers{$key} = $hash->{$key};
	}
}

=head2 gotTLVRequest( $udpsock, $clientpaddr, $msg )

Process TLV based discovery request and send appropriate response.

=cut

sub gotTLVRequest {
	my ($udpsock, $clientpaddr, $msg) = @_;

	use bytes;

	# Discovery request and responses contain TLVs of the format:
	# T (4 bytes), L (1 byte unsigned), V (0-255 bytes)
	# To escape from previous discovery format, request are prepended by 'e', responses by 'E'

	unless ($msg =~ /^e/) {
		$log->warn("bad discovery packet - ignoring");
		return;
	}

	if (main::DEBUGLOG && $log->is_debug) {
		$log->debug("discovery packet:" . Data::Dump::dump($msg));
	}

	# chop of leading character
	$msg = substr($msg, 1);
	
	my $len = length($msg);
	my ($t, $l, $v);
	my $response = 'E';

	# parse TLVs
	while ($len >= 5) {
		$t = substr($msg, 0, 4);
		$l = unpack("xxxxC", $msg);
		$v = $l ? substr($msg, 5, $l) : undef;

		main::DEBUGLOG && $log->debug(" TLV: $t len: $l");

		if ($TLVhandlers{$t}) {
			if (my $r = $TLVhandlers{$t}->($v)) {
				if (length $r > 255) {
					$log->warn("Response: $t too long truncating!");
					$r = substr($r, 0, 255);
				}
				$response .= $t . pack("C", length $r) . $r;
			}
		}

		$msg = substr($msg, $l + 5);
		$len = $len - $l - 5;
	}

	if (length $response > 1450) {
		$log->warn("Response packet too long not sending!");
		return;
	}

	main::INFOLOG && $log->info("sending response");

	$udpsock->send($response, 0, $clientpaddr);
}


=head1 SEE ALSO

L<Slim::Networking::UDP>

L<Slim::Networking::SliMP3::Protocol>

=cut

1;
