plex.pls

   1 #!/usr/bin/perl -w
   2 #
   3 # iceplex
   4 #
   5 # Copyright (c) 2003 Ivan Kohler
   6 # All rights reserved.
   7 # This program is free software; you can redistribute it and/or modify it under
   8 # the same terms as Perl itself.
   9
  10 use strict;
  11 use subs qw(suidsetup pick_server);
  12 use CGI;
  13 use CGI::Carp qw(fatalsToBrowser);
  14 use Digest::MD5 qw(md5_hex);
  15 use DBI;
  16 use Net::SSH qw(ssh);
  17
  18 suidsetup();
  19
  20 # pull in configuration
  21 use vars qw($dsn $user $pass $mp3path $port);
  22 use vars qw($override_query $fileno_query);
  23 use vars qw(%extension2type);
  24 require "/etc/iceplex.conf";
  25
  26 #detect .pls or .m3u filetype
  27 $0 =~ /\.(pls|m3u)$/i or die "must be named with .pls or .m3u extension";
  28 my $extension = lc($1);
  29
  30 #connect to database
  31 my $dbh = DBI->connect($dsn, $user, $pass) or die $DBI::errstr;
  32
  33 #pick a server
  34 my $server = pick_server();
  35
  36 #get customer & user from client browser
  37 my $cgi = new CGI;
  38 $cgi->param('customer') =~ /^(\d{1,10})$/ or die 'illegal customer numer';
  39 my $customer = sprintf("%6d", $1); #!! how many digits in customer #?
  40 $cgi->param('user') =~ /^(\d{1,10})$/ or die 'illegal user numer';
  41 my $user = sprintf("%4d", $1); #!! how many digits in user #?
  42
  43 #get file number
  44 my $fileno = '';
  45 if ( $override_query ) {
  46   my $sth = $dbh->prepare( $override_query ) or die $dbh->errstr;
  47   $sth->execute($customer, $user) or die $sth->errstr;
  48   my $row = $sth->fetchrow_arrayref;
  49   $fileno = $row->[0] if $row;
  50 }
  51 if ( !length($fileno) && $fileno_query ) {
  52   my $sth = $dbh->prepare( $fileno_query ) or die $dbh->errstr;
  53   $sth->execute($customer, $user) or die $sth->errstr;
  54   my $row = $sth->fetchrow_arrayref;
  55   die "No files for user $user of customer $customer" unless $row;
  56   $fileno = $row->[0];
  57 }
  58 $fileno = '000' unless length($fileno); #default
  59
  60 #genarate filename
  61 my $filename = "$mp3path/$customer-$user-$fileno.mp3";
  62
  63 #disconnect from database
  64 $dbh->disconnect;
  65
  66 #generate a mountpoint
  67 md5_hex($cgi->remote_host. $$. time. int(rand(4294967296))) =~ /^(\w+)$/;
  68 my $mountpoint = $1;
  69
  70 #signal encoder to start streaming to mountpoint & wait for confirmation
  71 warn "ssh $server yashout $filename $mountpoint $port\n";
  72 ssh($server, 'yashout', $filename, $mountpoint, $port );
  73
  74 #send file back to client browser
  75
  76 print $cgi->header( -type => $extension2type{$extension} );
  77 print "[playlist]\nNumberOfEntries=1\nFile1=" if $extension eq 'pls';
  78 print "http://$server:$port/$mountpoint\n";
  79
  80 ###
  81 # subroutiens
  82 ###
  83
  84 sub suidsetup {
  85   $ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
  86   $ENV{'SHELL'} = '/bin/sh';
  87   $ENV{'IFS'} = " \t\n";
  88   $ENV{'CDPATH'} = '';
  89   $ENV{'ENV'} = '';
  90   $ENV{'BASH_ENV'} = '';
  91
  92   $< = $>; #correct uid for spawned ssh process
  93 }
  94
  95 sub pick_server {
  96   my $sth = $dbh->prepare(
  97     "SELECT servername FROM iceplex_servers ".
  98     "WHERE status = 'online' ".
  99     "ORDER BY listeners ASC LIMIT 1"
 100   ) or die $dbh->errstr;
 101   $sth->execute() or die $sth->errstr;
 102   my $row = $sth->fetchrow_arrayref;
 103   die "No servers online!" unless $row;
 104   $row->[0];
 105 }
 106