bin/adorno

   1 #!/usr/bin/perl
   2 # $Id: adorno 35 2003-11-04 08:56:13Z  $
   3 #
   4 # (c) 2002, 2003 Andrew McMillan - licensed under GPL version 2
   5 #
   6
   7 use strict;
   8
   9 use Sys::Syslog;
  10 use Time::HiRes qw( usleep );
  11 use POSIX qw(strftime);
  12
  13 use MP3::Info;
  14 use Ogg::Vorbis::Header;
  15
  16 my %opts = (
  17              database => 'adorno',
  18              dbuser   => '',
  19              fifo     => '/var/run/adorno/fifo',
  20              pidfile  => '/var/run/adorno/adorno.pid',
  21              dumpfile => '/var/run/adorno/queue.txt',
  22              config   => '/etc/adorno/adorno.conf',
  23              debug    => 0 );
  24
  25
  26 sub usage {
  27   print <<EOUSAGE ;
  28 Usage:
  29   $0 [options ...]
  30
  31 Options:
  32   -d | --database <dbname>  Use this database (adorno)
  33   -u | --user <username>    Log onto database as this user
  34   --fifo <fifo_path>        The path to the fifo ($opts{'fifo'})
  35   --dumpfile <dump_path>    The path to the file adorno dumps it's queue in ($opts{'dumpfile'})
  36   --pid <pidfile_path>      The path to the file adorno writes it's PID in ($opts{'pidfile'})
  37   --config <config_path>    The path to the configuration file ($opts{'config'})
  38   --debug     Debugging information
  39   --help      Request this help text
  40
  41 Note: The database options are bogus as yet - Adorno currently
  42 does not connect to the database :-)
  43
  44 EOUSAGE
  45
  46   exit shift;
  47 }
  48
  49
  50 while( my $opt = shift ) {
  51   if ( $opt =~ /^-/ ) {
  52     if    ( $opt =~ /^-(d|-database)$/ ) { $opts{'database'}  = shift; }
  53     elsif ( $opt =~ /^-(u|-user)$/     ) { $opts{'dbuser'}    = shift; }
  54     elsif ( $opt =~ /^--fifo$/         ) { $opts{'fifo'}      = shift; }
  55     elsif ( $opt =~ /^--dumpfile$/     ) { $opts{'dumpfile'}  = shift; }
  56     elsif ( $opt =~ /^--pidfile$/      ) { $opts{'pidfile'}   = shift; }
  57     elsif ( $opt =~ /^--config$/       ) { $opts{'config'}    = shift; }
  58     elsif ( $opt =~ /^--debug$/        ) { $opts{'debug'}     = 1;     }
  59     elsif ( $opt =~ /^--help$/         ) { usage(0); }
  60     else {
  61       usage(1);
  62     }
  63   }
  64   else {
  65     usage(1);
  66   }
  67 }
  68
  69
  70 my $next_track = "";
  71 my $player_started = 0;
  72 my $player_pid = 0;
  73 my $parent_process = 1;  # set to 0 in the child process immediately after it starts
  74
  75 my @queue;
  76
  77 # Some things may be set in the config file, but here are
  78 # defaults.
  79 my @oggstream = ( "ogg123", "-q" );
  80 my @mp3stream = ( "mpg321", "-q" );
  81 my @oggfile   = ( "ogg123", "-q" );
  82 my @mp3file   = ( "mpg321", "-q" );
  83
  84 # Used if we configure scrobbler
  85 my $scrobbler = {};
  86 my $scrob;
  87
  88 # Read config file
  89 open( CONFIG, "<", $opts{'config'} ) and do {
  90   while( <CONFIG> ) {
  91     chomp;
  92     /^\s*oggstream\s*=\s*(\S.*)$/i && do { @oggstream = split /\s+/, $1 ; };
  93     /^\s*oggfile\s*=\s*(\S.*)$/i   && do { @oggfile   = split /\s+/, $1 ; };
  94     /^\s*mp3stream\s*=\s*(\S.*)$/i && do { @mp3stream = split /\s+/, $1 ; };
  95     /^\s*mp3file\s*=\s*(\S.*)$/i   && do { @mp3file   = split /\s+/, $1 ; };
  96     /^\s*scrobbler\[([^]]+)\]\s*=\s*(\S.*)$/i && do {
  97       logf( "info", "Scrobbler->{$1} = $2" ) if ( $opts{'debug'} );
  98       $scrobbler->{$1} = $2 ;
  99     };
 100   }
 101 };
 102
 103 logf( 'warning', "Adorno Music Server starting (c) 2003-2006 Andrew McMillan" );
 104
 105 # Subroutine to ensure we don't zombie out.
 106 sub REAPER {
 107   my $waitedpid = wait;
 108   $SIG{CHLD} = \&REAPER;
 109 }
 110
 111
 112 # Create the fifo if necessary
 113 my $fifo_perms = oct(10666);
 114 unless (-p $opts{'fifo'}) {
 115    unlink $opts{'fifo'};
 116    system('mknod', $opts{'fifo'}, 'p') or logf( 'warning', "can't mknod $opts{'fifo'}: $!");
 117    chmod $fifo_perms, $opts{'fifo'} or logf( 'warning', "can't chmod %o $opts{'fifo'}: $!", $fifo_perms);
 118 }
 119
 120 # Ensure anyone can write to that...
 121 my $i = 0;
 122 while ( $i++ < 10 && (stat($opts{'fifo'}))[2] != $fifo_perms ) {
 123
 124   logf( 'notice', "Setting %o permissions on $opts{'fifo'} currently %o",
 125                            $fifo_perms, (stat($opts{'fifo'}))[2] );
 126   chmod $fifo_perms, $opts{'fifo'} or logf( 'warning', "can't chmod %o $opts{'fifo'}: $!", $fifo_perms );
 127   if ( $i >= 10 ) {
 128     logf( 'crit', "Can't set %o permissions on $opts{'fifo'} - giving up completely", $fifo_perms);
 129     exit;
 130   }
 131   sleep 2;
 132 }
 133
 134
 135 unless ( $opts{'debug'} ) {
 136   # Fork into background as a good daemon should when we're not debugging...
 137   $SIG{CHLD} = \&REAPER;   $player_pid = fork;
 138   if ( $player_pid ) {
 139      open (PIDFILE, "> $opts{'pidfile'}") || logf( 'crit', "Parent can't save PID in $opts{'pidfile'} $!");
 140      print PIDFILE "$player_pid";
 141      close PIDFILE;
 142      exit;
 143   }
 144 }
 145
 146
 147 if ( defined($scrobbler->{'username'}) ) {
 148   logf( 'warning', "Using Audio::Scrobbler interface" );
 149   use Audio::Scrobbler;
 150   $scrob = new Audio::Scrobbler( cfg => $scrobbler );
 151   $scrob->handshake() or do {
 152     logf( 'warning', "Scrobbler initialisation failed" );
 153     undef($scrob);
 154   };
 155 }
 156
 157
 158 ###########################################################
 159 # Thinly veiled wrapping of syslog!
 160 #
 161 ###########################################################
 162 sub logf {
 163   openlog('adorno', 'cons,pid', 'user');
 164   syslog( @_ );
 165   closelog();
 166   if ( shift =~ /crit/ ) {
 167     die @_;
 168   }
 169   if ( $opts{'debug'} ) {
 170     print scalar localtime, ": ";
 171     printf @_ ;
 172     print "\n";
 173   }
 174 }
 175
 176 ###########################################################
 177 # Dump the queue out to a file for other software to
 178 # peruse, and also to syslog if we are debugging...
 179 #
 180 ###########################################################
 181 sub dump_queue {
 182
 183   open( DUMP, "> $opts{'dumpfile'}" ) || return;
 184   logf 'debug', "Currently playing: $next_track" if ( $opts{'debug'} );
 185   print DUMP $next_track, "\n";
 186   print DUMP $player_started, "\n";
 187   foreach my $i (0 .. $#queue ) {
 188     logf 'debug', $queue[$i] if ( $opts{'debug'} );
 189     print DUMP $queue[$i], "\n";
 190   }
 191   close( DUMP );
 192 }
 193
 194 ###########################################################
 195 # Send a command to the fifo to tell the master process to
 196 # do something.
 197 #
 198 ###########################################################
 199 sub send_command_to_fifo {
 200   my $command = shift;
 201
 202   open (CHFIFO, "> $opts{'fifo'}") || logf( 'err', "Child can't open $opts{'fifo'}: $!");
 203   print CHFIFO "$command\n";
 204   close CHFIFO;
 205   logf 'info', ($parent_process ? "PARNT" : "CHILD") . ": Commanded \"$command\"";
 206 }
 207
 208
 209 ###########################################################
 210 # Start a player to play the track
 211 #
 212 ###########################################################
 213 sub run_player {
 214 my $track = shift(@_);
 215 my @cmdline;
 216 my $result;
 217
 218   # Ensure the on-disk list of tracks is up-to-date.
 219   dump_queue();
 220
 221   return if ( "$track" eq "" );
 222
 223   if ( $track =~ /^http:/i ) {                      # Streaming URLs
 224     if ( $track =~ /\.ogg$/i ) {                    #   Streaming OGGs
 225       # push @cmdline, "ogg123", "-q", "-b", "512", "-p", "10", $track;
 226       @cmdline = @oggstream;
 227     }
 228     else {                                          #   Assume streaming MP3
 229       # push @cmdline, "mpg123", "-y", "-q", "-b", "384", $track ;
 230       @cmdline = @mp3stream;
 231     }
 232   }
 233   elsif ( $track =~ /\.mp3$/i ) {                   # File MP3
 234     if ( ! -f $track ) {
 235       logf( 'err', "PARNT: \"$track\" doesn't actually exist");
 236       $next_track = shift @queue;
 237       run_player( $next_track );
 238       return;
 239     }
 240     # push @cmdline, "playmp3", $track;
 241     @cmdline = @mp3file;
 242   }
 243   elsif ( $track =~ /\.ogg$/i ) {                   # File OGG
 244     if ( ! -f $track ) {
 245       logf( 'err', "PARNT: \"$track\" doesn't actually exist");
 246       $next_track = shift @queue;
 247       run_player( $next_track );
 248       return;
 249     }
 250     # push @cmdline, "ogg123", "-q", "-b", "512", "-p", "5", $track;
 251     @cmdline = @oggfile;
 252   }
 253   else {
 254     # Buggadifino!  Skip this one and go to the next.
 255     logf 'err', "PARNT: Unknown music format: \"$track\"";
 256     $next_track = shift @queue;
 257     run_player( $next_track );
 258     return;
 259   }
 260
 261   # Ensure the on-disk list of tracks is up-to-date, again...
 262   # And this time note when we started on the new track
 263   $player_started = strftime "%Y-%m-%d %H:%M:%S", localtime;
 264   dump_queue();
 265
 266   push @cmdline, $track;
 267
 268   logf 'info', "PARNT: Forking to run '@cmdline'";
 269   $SIG{CHLD} = \&REAPER; $player_pid = fork;
 270   if ( ! $player_pid ) {
 271     ########################### CHILD PROCESS #######################
 272     $parent_process = 0;  # Since we're the child...
 273     logf 'info', "CHILD: Running: @cmdline";
 274     my $began_playing = time;
 275     ($result = system(@cmdline)) == 0 or logf( 'err', "CHILD: @cmdline failed: $? $!");
 276     logf 'info', "CHILD: Result of player was $result, asking for next... - don't kill us!";
 277     send_command_to_fifo("next nokill");
 278
 279     if ( (time - $began_playing) > 20 ) {
 280       if ( defined($scrob) ) {
 281         logf 'info', "CHILD: Will try to submit to Scrobbler";
 282         my $track_details = get_track_info($track);
 283         $scrob->submit( $track_details ) if ( $track_details->{'length'} > 30 );
 284       }
 285       else {
 286         logf 'info', "CHILD: Scrobbler does not appear to be configured.";
 287       }
 288     }
 289     else {
 290       logf 'info', "CHILD: Track too short for scrobbling.";
 291     }
 292
 293     usleep(100000);  # Is this really necessary?
 294     logf 'info', "CHILD: exiting!";
 295     exit($result);  # Should we care enough to pass our resultcode back?
 296     ####################### END CHILD PROCESS #######################
 297   }
 298   logf 'info', "PARNT: Started to play $track (PID $player_pid)";
 299
 300 }
 301
 302
 303 #####################################################################
 304 # Get Track Information
 305 #####################################################################
 306 sub get_track_info {
 307   my $filename = shift;
 308
 309   my $info = {
 310                'artist' => 'Unknown',
 311                'album'  => 'Unknown',
 312                'title'  => 'Unknown',
 313                'length' => 0
 314              };
 315
 316   return $info if ( $filename !~ /\.(ogg|mp3)$/ );
 317
 318   if ( $filename =~ /\.mp3$/ ) {
 319     # Get the info out of the (hopefully) .mp3 file
 320     my $mp3info = get_mp3info($filename) or do {
 321       logf( "warning", "No MP3 info for $filename (the file is likely to be unplayable).");
 322       return $info;
 323     };
 324     my $mp3tag = get_mp3tag($filename) or do {
 325       logf( "warning", "No ID3 tag info for $filename");
 326       return $info;
 327     };
 328     $info->{'artist'} = $mp3tag->{'ARTIST'};
 329     $info->{'album'}  = $mp3tag->{'ALBUM'};
 330     $info->{'title'}  = $mp3tag->{'TITLE'};
 331     $info->{'length'}  = ($mp3info->{'MM'} * 60) + $mp3info->{'SS'};
 332   }
 333   else {
 334     # Get the info out of the (presumed) .ogg file
 335     my $ogghdr = Ogg::Vorbis::Header->load($filename) or do {
 336       logf( "warning", "No Ogg Vorbis info for $filename");
 337       return $info;
 338     };
 339     $info->{'length'}  = int( $ogghdr->info('length'));
 340
 341     foreach my $key ($ogghdr->comment_tags) {
 342       foreach my $value ( $ogghdr->comment($key) ) {
 343         if    ( $key =~ /artist/i   ) { $info->{'artist'} = $value; }
 344         elsif ( $key =~ /album/i    ) { $info->{'album'}  = $value; }
 345         elsif ( $key =~ /title/i    ) { $info->{'title'}  = $value; }
 346       }
 347     }
 348   }
 349
 350   logf( 'info', "PARNT: Scrobbler: Artist=%s, Album=%s, Title=%s, Length=%s", $info->{'artist'}, $info->{'album'}, $info->{'title'}, $info->{'length'} );
 351
 352   return $info;
 353 }
 354
 355
 356 #####################################################################
 357 # Get children of a process
 358 #  - this is somewhat architecture dependent.  It works OK on Linux
 359 #    2.5.73, but I am a wee mite worried that it ties itself to the
 360 #    /proc architecture.  Of course the alternative is to tie it to
 361 #    something further up the food chain, but do we gain a lot?
 362 #
 363 #####################################################################
 364 sub get_child_pids {
 365   my $parent_pid = shift @_;
 366   my @children;
 367   my $subpid;
 368   my ($pid, $j1, $j2, $ppid);
 369
 370   logf 'info', "PARNT: Looking for children of $parent_pid...";
 371
 372   opendir( PROC, "/proc" );
 373   while( $subpid = readdir( PROC ) ) {
 374     if ( $subpid =~ /^[0-9]+$/ ) {
 375       open( PROCSTAT, "/proc/$subpid/stat" );
 376       while( <PROCSTAT> ) {
 377         # This has some dependency on /proc format, but these fields are
 378         # surely low-risk.
 379         ($pid, $j1, $j2, $ppid) = split;
 380         if ( $ppid == $parent_pid ) {
 381           logf 'debug', "PARNT: Found $pid child of $parent_pid";
 382           push @children, $pid, get_child_pids($pid);
 383         }
 384       }
 385       close( PROCSTAT );
 386     }
 387   }
 388   closedir( PROC );
 389   return @children;
 390 }
 391
 392
 393 ###########################################################
 394 # Sometimes we just want to pause it...
 395 #
 396 ###########################################################
 397 sub pause_player {
 398   if ( ! $player_pid ) { return; }
 399   my $parent = $player_pid;
 400   my @children = get_child_pids( $parent );
 401   logf 'info', "PARNT: STOPping children @children (child of $player_pid)";
 402   kill 19, @children ;
 403   logf 'info', "PARNT: Done stopping processes...";
 404 }
 405
 406
 407 ###########################################################
 408 # and restart it...
 409 #
 410 ###########################################################
 411 sub resume_player {
 412   if ( ! $player_pid ) { return; }
 413   my $parent = $player_pid;
 414   my @children = get_child_pids( $parent );
 415   logf 'info', "PARNT: CONTing children @children (child of $player_pid)";
 416   kill 18, @children ;
 417   logf 'info', "PARNT: Done continuing processes...";
 418 }
 419
 420
 421
 422 ###########################################################
 423 # and sometimes it just deserves to die...
 424 #
 425 ###########################################################
 426 sub kill_player {
 427   if ( ! $player_pid ) { return; }
 428   my $parent = $player_pid;
 429   my @children = get_child_pids( $parent );
 430   if ( $#children == 0 ) {
 431     logf 'info', "PARNT: No kids! (children of $player_pid)";
 432     return 1;
 433   }
 434   logf 'info', "PARNT: TERMing children @children (child of $player_pid)";
 435   kill 15, @children ;
 436
 437   # Now wait until all of those children are actually dead.
 438   usleep(10000);
 439   @children = get_child_pids( $parent );
 440   while( $#children > 0 ) {
 441     logf 'info', "PARNT: Waiting for $#children to die.";
 442     usleep(10000);
 443     @children = get_child_pids( $parent );
 444   }
 445   $player_pid = 0;
 446   logf 'info', "PARNT: Done terminating processes...";
 447   return 0;
 448 }
 449
 450
 451 ###########################################################
 452 # Main loop.  Forever just keep reopening and reading our
 453 # fifo and acting on the commands we receive.
 454 ###########################################################
 455 while( 1 ) {
 456
 457   logf 'info', "PARNT: Opening fifo";
 458   if ( open (FIFO, "< $opts{'fifo'}") ) {
 459
 460     logf 'info', "PARNT: Waiting for a command";
 461
 462     # next line blocks until there's a reader
 463     while( <FIFO> ) {
 464       logf 'info', "PARNT: FIFO Says: $_";
 465
 466       # Quit the application.  Cron will probably restart it...
 467       /^quit/i && do {
 468         kill_player;
 469         close FIFO;
 470         exit;
 471       };
 472
 473       # Suspend the track being played
 474       /^pause/i && do {
 475         pause_player;
 476       };
 477
 478       # Resume the suspended track
 479       /^resume/i && do {
 480         resume_player;
 481       };
 482
 483       # Power Down
 484       /^off/i && do {
 485         kill_player;
 486         close FIFO;
 487         exec "shutdown -h now";
 488       };
 489
 490       # Nuke everything in the current queue
 491       /^clear$/i && do {
 492         @queue = list();
 493         dump_queue();
 494       };
 495
 496       # Put this track at the beginning of the queue
 497       /^play (.*)$/i && do {
 498         if ( $player_pid ) {
 499           unshift @queue, $1;
 500           dump_queue();
 501         }
 502         else {
 503           $next_track = $1;
 504           run_player( $1 );
 505         }
 506       };
 507
 508       # Put this track at the end of the queue
 509       /^queue (.*)$/i && do {
 510         if ( $player_pid ) {
 511           push @queue, $1;
 512           dump_queue();
 513         }
 514         else {
 515           $next_track = $1;
 516           run_player( $1 );
 517         }
 518       };
 519
 520       # Kill the currently playing track (which will start a new one)
 521       /^next(.*)$/i && do {
 522         if ( $1 =~ /nokill/ ) {
 523           $player_pid = 0;
 524           $next_track = shift @queue;
 525           run_player( $next_track );
 526         }
 527         else {
 528           # which will call us back with a `next nokill', or exit as true
 529           if ( kill_player() ) {
 530             $player_pid = 0;
 531             $next_track = shift @queue;
 532             run_player( $next_track );
 533           }
 534         }
 535       };
 536     }
 537     close FIFO;
 538
 539   }
 540   else {
 541     logf( 'err', "Couldn't open $opts{'fifo'}: $!");
 542     sleep 1;
 543   }
 544
 545 }
 546
 547 logf 'info', "PARNT: Exiting";