#!/usr/bin/perl
# 
# StreamyUPnP.pl v0.1.0000
# Courtesy of George McMullen
#
# I have been frustrated for a while with the features and performance in the
# Philips Media Manager for my Streamium MC-i200. On top of that, my own 
# frustrations are echoed in the posts I see on the Streamium Cafe site.
# While the Streamium pretends to be UPnP, it is not really, nor is it
# compatible with other true UPnP devices. On top of that, Philips maintains
# true UPnP support can not be implemented into future firmware releases and
# that is because of some limitations in the hardware. I contend that this
# is not true, and is only because Philips does not wish to support hardware
# that is only a few years old. To prove my point, I present StreamyUPnP, a
# proxy between Streamiums and true UPnP servers. StreamyUPnP is a Perl program
# that looks like PMM to your Streamium, translates Streamium requests to your
# UPnP server, gets the UPnP results, and translates/sends them back to the
# Streamium. It is actually quite simple, as evidenced by the small size of
# this script. Streamiums have about 4mb or so of RAM internally and are
# actually quite sophisticated inside. I wrote this in a matter of a few hours,
# basing the PC-Link part on Nathan Peterson's code, and the UPnP part on the
# straight sample code from CPAN. It should still only be taken as a proof
# of concept. There are probably a few bugs here and there, it hasn't been fully
# tested, and the code isn't as well formatted as I would like it to be.
# If I have time in the future, I will update it and add features as
# necessary. If you have feedback, look me up as CuriousG on Streamium Cafe.
#
#
# Features / Benefits:
# - Can sit on the same machine as your UPnP software, as long as PMM is not running
# - The only thing that requires configuration is the PreferredServerName
# - Acts completely transparently to the Streamium, which will never know it is not connecting with a PMM server
# - Will allow users to run Vista, which PMM cannot run on
# - No need to re-organize and run scripts to collect info about your music collection when your UPnP server has already done the work
# 
# Room for improvement:
# - Only simple testing performed with:
#   - SimpleServer Basic
#   - TwonkyVision
#   - On2Share Pro
# - Untested or unable to get working with:
#   - WinAmp Remote (something goes haywire after trying to browse the next level down
# - Only tested on Windows machines so far
# - Although there is an option for SortCriteria, defaulting to track number, so far I have not seen this supported by UPnP media servers
# - It is based on Nathan Peterson's code, so it also does not know how to handle two Streamiums on the same network.
# - I'll admit I have a limited knowledge of the UPnP protocol, thus the implementation must be even more limited
# - No real error handling, which might cause issues
# - In writing the program, I found that the Streamium cannot accept Node IDs that are not numeric, which UPnP node IDs usually are,
#   thus I had to keep my own index of node IDs as they were browsed by the Streamium. This may cause issues.
# - The Streamium gets data in chunks of 32 nodes. This may not be completely implemented here.
#
# Requirements
# - Perl 5.8.x (I have been using the Active State Perl package)
# - Net::UPnP Package
# - XML::Simple Package
#
# Thanks to the following folks:
# - Nathan Peterson (http://www.siteswap.org/streamium/) for his PCLink code and analysis of the protocol when it first came out
# - The wonderful community at Streamium Cafe
# - UPnP Perl writer Satoshi Konno
# - Perl XML Simple writer Grant McLean
# - Streamiumd writer Dave Witt
# - The few folks at Philips who do try to help people when they can
#

use IO::Socket;
use IO::Select;
use Net::UPnP::ControlPoint;
use XML::Simple;

#
# Note these global variables should be edited to your configuration
#
$conf{'PreferredServerName'} = "TwonkyVision"; # Configure this to be the ID of your UPnP server
$conf{'EnterOnExit'} = 1; 
$conf{'debug'} = 0;
$conf{'SortCriteria'}= "+upnp:originalTrackNumber";

#
#
# Set up the UPnP device
#
#
my $xmlParser = XML::Simple->new(ForceArray => 1);
my $upnpObj = Net::UPnP::ControlPoint->new();

@dev_list = $upnpObj->search(st =>'upnp:rootdevice', mx => 3);

$devNum= 0;
foreach $dev (@dev_list)
{
  $device_type = $dev->getdevicetype();
  if ($device_type ne 'urn:schemas-upnp-org:device:MediaServer:1')
  {
      next;
  }
  print "[$devNum] : " . $dev->getfriendlyname() . "\n" if $conf{'debug'};

  if ($dev->getfriendlyname() eq $conf{'PreferredServerName'})
  {
    $device=$dev;
    last;
  }
  $devNum++;
}

if (! $device)
{
  print "Error: Unable to find configured UPnP device ".$conf{'PreferredServerName'}." on network. Run StreamyUPnP in debug mode to ensure that you have the correct name.\n";
  &Quitter();
}

$dev=$device;
for ($i=0; $i<=0; $i++)
{
  unless ($dev->getservicebyname('urn:schemas-upnp-org:service:ContentDirectory:1'))
  {
    next;
  }
  $condir_service = $dev->getservicebyname('urn:schemas-upnp-org:service:ContentDirectory:1');
  unless (defined(condir_service))
  {
      next;
  }
}

#
#
# Set up the sockets, wait for broadcast, make connection
#
#
# Will need for later
$sock_sel = new IO::Select();

# Open UDP sock for listening
$udpsock = new IO::Socket::INET (LocalPort => 42591,
                                 Proto     => 'udp'
                                );
die "Could not connect: $!" unless $udpsock;

RESTART: # jump back to here if we need to restart the server

# Wait for UDP broadcast
$udpsock->recv($datagram, 4096);
$clientIP = $udpsock->peerhost();

print "$datagram\n\n" if $conf{'debug'};
# start over if not pclink client
if($datagram !~ /^<PCLinkClient>/){ goto(RESTART); }

# Open tcpsock connection
$hellosock = new IO::Socket::INET (PeerAddr => $clientIP,
                                   PeerPort => 42951,
                                   Proto    => 'tcp'
                                  );
die "Socket could not be created.  Reason: $!\n" unless $hellosock;

# record my IP address for later
#$myIP = $hellosock->sockhost();

# Send Hello, close connection
&hello_resp($hellosock,$conf{'PreferredServerName'});
close ($hellosock);

# Open tcpsock for listening
$pclinksock = new IO::Socket::INET (LocalPort => 42951,
                                    Proto     => 'tcp',
                                    Listen    => 1,
                                    Reuse     => 1
                                   );
die "Could not connect: $!" unless $pclinksock;

$sock_sel->add($udpsock);
$sock_sel->add($pclinksock);

#
#
# Main loop
#
#
while(1){
  # get a set of readable handles (blocks until at least one handle is ready)
  # take all readable handles in turn
  @ready = $sock_sel->can_read();
  foreach $rsock (@ready) {
    # if it is pclinksock then we should accept(), read, and respond
    if($rsock == $pclinksock){
      $connection = $pclinksock->accept();
      ($node,$elem,$index) = &get_node($connection);

      $data = &make_xml($node,$elem,$index);
      &pclink_send($connection, $data);
      close($connection);
    }
    # if it is udpsock then client has reset so we must close tcp sock and restart server
    # note that it highly unlikely that some non-pclink client is broadcasting on this port, so we will take our chances.
    elsif($rsock == $udpsock){
      $sock_sel->remove($udpsock);
      $sock_sel->remove($pclinksock);
      close($pclinksock);
      goto(RESTART);
    }
    # otherwise wtf?!?
    else {
      die "unknown handle: $rsock";
    }
  }
}


################
## Subroutines
################

sub hello_resp {
  my ($sock,$name) = @_;
  my ($IP) = $sock->sockhost();
  my (@IP) = split /\./,$IP;

  # convert IP address to little endian
  $IP = $IP[0] + $IP[1]*0x100 + $IP[2]*0x10000 + $IP[3]*0x1000000;

  my ($hello) = "<PCLinkServer><Version>1.0</Version><VendorID>MUSICMATCH</VendorID><name>$name</name><ShortName>$name</ShortName><IP>$IP</IP><Port>51111</Port></PCLinkServer>\n";

  print $sock $hello;
  print $hello if $conf{'debug'};
  $sock->flush(); # is this necessary?
}

sub pclink_send {
  my ($sock,$data) = @_;
  my ($datalen) = length $data;
  my ($header) = "HTTP/1.0 200 OK\r\nAccept-Ranges: bytes\r\nContent-Length:$datalen\r\nContent-Type: text/xml\r\n\r\n";

  print $sock $header.$data;
  print $header.$data if $conf{'debug'};
  $sock->flush(); # is this necessary?
}

sub get_node {
  my ($sock) = @_;
  my ($datagram,$nodeID,$numelem,$fromindex);

  $sock->recv($datagram, 4096);
  print "\n\n$datagram\n" if $conf{'debug'};
  $nodeID = ($datagram =~ /<nodeid>(.*)<\/nodeid>/ ? $1 : 0);
  $numelem = ($datagram =~ /<numelem>(.*)<\/numelem>/ ? $1 : 0);
  $fromindex = ($datagram =~ /<fromindex>(.*)<\/fromindex>/ ? $1 : 0);
  return ($nodeID,$numelem,$fromindex);
}

sub make_xml {
  my ($node,$elem,$index) = @_;
  local ($ref, @nodesInLevel, $i, $thisnodeID);

  $ref = &BrowseNode($node);
  $xml = "<contentdataset>";

  if ($ref->{container})
  {
    @nodesInLevel=keys %{$ref->{container}};
    if ($#nodesInLevel > -1 )
    {
      for ($i=$index; $i<=$#nodesInLevel; $i++)
      {
        if ((! $nodeIDs{$nodesInLevel[$i]}) && ($nodesInLevel[$i] ne "0"))
        {
          $nodeNames[$#nodeNames+1]=$nodesInLevel[$i];
          $nodeIDs{$nodesInLevel[$i]}=$#nodeNames;
          $thisnodeID=$#nodeNames;
        }
        else
        {
          $thisnodeID=$nodeIDs{$nodesInLevel[$i]};
        }
        print "$i: ".$ref->{container}->{$nodesInLevel[$i]}->{"dc:title"}->[0]." - (Node: ".$nodesInLevel[$i].")\n" if $conf{'debug'};
        $xml = $xml."<contentdata><name>".$ref->{container}->{$nodesInLevel[$i]}->{"dc:title"}->[0]."</name><nodeid>".$thisnodeID."</nodeid><branch/></contentdata>";
      }
    }
  }
  elsif ($ref->{item})
  {
    @nodesInLevel=keys %{$ref->{item}};
    if ($#nodesInLevel > -1 )
    {
      for ($i=$index; $i<=$#nodesInLevel; $i++)
      {
        if ((! $nodeIDs{$nodesInLevel[$i]}) && ($nodesInLevel[$i] ne "0"))
        {
          $nodeNames[$#nodeNames+1]=$nodesInLevel[$i];
          $nodeIDs{$nodesInLevel[$i]}=$#nodeNames;
          $thisnodeID=$#nodeNames;
        }
        else
        {
          $thisnodeID=$nodeIDs{$nodesInLevel[$i]};
        }

        print "$i: ".$ref->{item}->{$nodesInLevel[$i]}->{"dc:title"}->[0]." - (Node: ".$nodesInLevel[$i].")\n" if $conf{'debug'};
        $xml = $xml."<contentdata><name>".$ref->{item}->{$nodesInLevel[$i]}->{"dc:title"}->[0]."</name>";
        $xml = $xml."<nodeid>".$thisnodeID."</nodeid><playable/>";
        $xml = $xml."<url>".$ref->{item}->{$nodesInLevel[$i]}->{res}->[0]->{content}."</url>";
        $xml = $xml."<title>".$ref->{item}->{$nodesInLevel[$i]}->{"dc:title"}->[0]."</title>";
        $xml = $xml."<album>".$ref->{item}->{$nodesInLevel[$i]}->{"upnp:album"}->[0]."</album>";
        $xml = $xml."<trackno>".$ref->{item}->{$nodesInLevel[$i]}->{"upnp:originalTrackNumber"}->[0]."</trackno>";
        $xml = $xml."<artist>".$ref->{item}->{$nodesInLevel[$i]}->{"dc:creator"}->[0]."</artist>";
        $xml = $xml."<genre>".$ref->{item}->{$nodesInLevel[$i]}->{"upnp:genre"}->[0]."</genre>";
        $xml = $xml."<year></year>";
        $xml = $xml."<bitrate>".$ref->{item}->{$nodesInLevel[$i]}->{res}->[0]->{bitrate}."</bitrate>";
        $xml = $xml."<playlength>".&durationSeconds($ref->{item}->{$nodesInLevel[$i]}->{res}->[0]->{duration})."</playlength>";
        $xml = $xml."</contentdata>";
      }
    }
  }

  $xml = $xml."<totnumelem>".($#nodesInLevel+1)."</totnumelem><fromindex>0</fromindex><numelem>".($#nodesInLevel+1)."</numelem><alphanumeric/></contentdataset>\n";

  return $xml;
}

sub durationSeconds
{
  local ($duration)=@_;
  
  if ($duration =~ /\:/)
  {
    local ($hours,$mins,$seconds)=split (/\:/, $duration);
    $duration = ($hours*60*60)+($mins*60)+$seconds;
  }
  $duration=~ s/\..*$//;
  return ($duration);
}

sub Quitter
{
  if ($conf{'EnterOnExit'})
  {
    print "Press enter: ";
    $line=<>;
  }
  exit;
}

sub BrowseNode
{
  my ($node) = @_;
  local ($ref, $result, $objectID, $action_res);

  if (($node eq "") || ($node == 0))
  {
    $objectID='0';
    $nodeNames[0]=0;
    $nodeIDs{0}=0;
  }
  else
  {
    $objectID=$nodeNames[$node];
  }

  if (! $objectID)
  {
    $objectID='0';
    $nodeNames[0]=0;
    $nodeIDs{0}=0;
  }

  %action_in_arg = (
          'ObjectID' => $objectID,
          'BrowseFlag' => 'BrowseDirectChildren',
          'Filter' => '*',
          'StartingIndex' => 0,
          'RequestedCount' => 0,
          'SortCriteria' => $conf{'SortCriteria'},
      );

  $action_res = $condir_service->postcontrol('Browse', \%action_in_arg);
  if ($action_res->getstatuscode() != 200)
  {
    return();
  }
  
  $actrion_out_arg = $action_res->getargumentlist();
  
  if (! $actrion_out_arg->{'Result'})
  {
    return();
  }
  
  $result = $actrion_out_arg->{'Result'};
 
  $ref = $xmlParser->XMLin($result);
  
  if ($conf{'debug'})
  {
    use Data::Dumper;
    open (OUTFILE, ">>ControlPoint.log");
    print OUTFILE "\n\n";
    print OUTFILE "$objectID";
    print OUTFILE "\n\n";
    print OUTFILE Dumper($ref);
    close (OUTFILE);
  }
  return ($ref);
}