soepkiptngd

   1 #!/usr/bin/perl -w
   2 ############################################################################
   3 # soepkiptngd (Soepkip The Next Generation daemon)
   4 #
   5 # (c) copyright 2000 Eric Lammerts <eric@lammerts.org>
   6 #
   7 # loosely based on `mymusic' by "caffiend" <caffiend@atdot.org>
   8 # and `Radio Soepkip' by Andre Pool <andre@scintilla.utwente.nl>
   9 #
  10 ############################################################################
  11 # This program is free software; you can redistribute it and/or modify
  12 # it under the terms of the GNU General Public License, version 2, as
  13 # published by the Free Software Foundation.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # A copy of the GNU General Public License is available on the World Wide Web
  21 # at `http://www.gnu.org/copyleft/gpl.html'.  You can also obtain it by
  22 # writing to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 # Boston, MA 02111-1307, USA.
  24 ############################################################################
  25
  26 use Cwd 'abs_path';
  27 use DBI;
  28 use Errno;
  29 use Fcntl;
  30 use Getopt::Std;
  31 use IO::Handle;
  32 use IO::Socket;
  33 use POSIX ":sys_wait_h";
  34 use Sys::Hostname;
  35 no warnings 'qw';
  36
  37 use integer;
  38 use strict;
  39 use vars qw(%conf $dbh $restart $opt_d $opt_r $opt_s $opt_c $cdrplaypid
  40         $pid_status $pid_signal $pid @preload $paused $randsong);
  41
  42 # find program directory
  43 $_ = $0;
  44 while(-l) {
  45         my $l = readlink or die "readlink $_: $!\n";
  46         if($l =~ m|^/|) { $_ = $l; } else { s|[^/]*$|/$l|; }
  47 }
  48 m|(.*)/|;
  49 my $progdir = abs_path($1);
  50
  51 require "$progdir/soepkiptng.lib";
  52
  53 my %soxformats;
  54
  55
  56 sub rotatelog(;$) {
  57         if($_[0] or -s STDERR > 65000) {
  58                 rename $conf{errfile}, "$conf{errfile}.old" or do {
  59                         warn "rename $conf{errfile} -> $conf{errfile}.old: $!\n";
  60                         return;
  61                 };
  62                 close STDERR;
  63                 open STDERR, ">$conf{errfile}";
  64                 STDERR->autoflush(1);
  65         }
  66 }
  67
  68 sub warnrotate {
  69         printf STDERR "%s %s", scalar localtime, $_[0];
  70         rotatelog();
  71 }
  72
  73 sub dierotate {
  74         printf STDERR "%s %s", scalar localtime, $_[0];
  75         rotatelog();
  76         exit 1;
  77 }
  78
  79 sub child_reaper {
  80         for(;;) {
  81                 my $p = waitpid(-1, &WNOHANG);
  82                 return if $p < 1;
  83                 warn sprintf "reaped child %d, sig=%d status=%d\n",
  84                         $p, $? & 0x7f, $? >> 8;
  85                 if($p == $cdrplaypid) {
  86                         unlink $conf{statusfile};
  87                         die "exiting because '$conf{playercmd}' died.\n";
  88                 } elsif($p == $pid) {
  89                         $pid = 0;
  90                         $pid_status = $? >> 8;
  91                         $pid_signal = $? & 0x7f;
  92                         warn "player finished ($p)\n";
  93                         if($paused) {
  94                                 warn "resuming output\n";
  95                                 player_cmd("resume") or warn "error resuming output\n";
  96                                 $paused = 0;
  97                         }
  98                 }
  99         }
 100 };
 101
 102 BEGIN {
 103         my %delete;
 104
 105         sub get_song_jingle() {
 106                 my $s = undef;
 107                 local *JINGLEDIR;
 108
 109                 if($conf{jingledir} && opendir JINGLEDIR, $conf{jingledir}) {
 110                         foreach(sort readdir JINGLEDIR) {
 111                                 next if /^\./;
 112                                 next if $delete{"$conf{jingledir}/$_"};
 113
 114                                 warn "playing jingle $conf{jingledir}/$_\n";
 115
 116                                 $s->{id} = -1;
 117                                 $s->{type} = 'J';
 118                                 $s->{filename} = "$conf{jingledir}/$_";
 119                                 $s->{artist} = '** Jingle **';
 120                                 $s->{album} = '';
 121                                 $s->{track} = 0;
 122                                 $s->{title} = $_;
 123                                 $s->{user} = '';
 124                                 $s->{length} = 0;
 125                                 $s->{encoding} = '';
 126                                 last;
 127                         }
 128                         closedir JINGLEDIR;
 129                 }
 130                 $delete{$s->{filename}} = 1 if $s;
 131                 return $s;
 132         }
 133
 134         sub delete_jingles() {
 135                 foreach(keys %delete) {
 136                         if(unlink $_ or $!{ENOENT}) {
 137                                 delete $delete{$_};
 138                         } else {
 139                                 warn "unlink $_: $!\n";
 140                         }
 141                 }
 142         }
 143 }
 144
 145 sub get_song_queued() {
 146         my $s = undef;
 147
 148         # get queued song
 149         $dbh->do("LOCK TABLES queue WRITE, song READ, artist READ, album READ");
 150         for(;;) {
 151                 my $sth = $dbh->prepare(
 152                         "SELECT queue.song_id as id,queue.song_order as song_order,".
 153                         "       queue.user as user, artist.name as artist,".
 154                         "       album.name as album, song.* FROM queue".
 155                         " LEFT JOIN song ON song.id=queue.song_id" .
 156                         " LEFT JOIN artist ON artist.id=song.artist_id" .
 157                         " LEFT JOIN album ON album.id=song.album_id" .
 158                         " ORDER BY queue.song_order" .
 159                         " LIMIT 1"
 160                 );
 161                 $sth->execute or last;
 162                 $s = $sth->fetchrow_hashref or last;
 163                 if($s->{present}) {
 164                         warn "playing queued $s->{filename}\n";
 165                         $s->{type} = 'Q';
 166
 167                         # delete it from the queue
 168                         $dbh->do("DELETE FROM queue WHERE song_id = $s->{id}");
 169                         $dbh->do("UPDATE queue SET song_order = song_order - $s->{song_order} - 1");
 170                         last;
 171                 }
 172
 173                 warn "deleting non-present song $s->{id} ($s->{filename})\n";
 174                 $dbh->do("DELETE FROM queue WHERE song_id = $s->{id}");
 175                 $s = undef;
 176         }
 177         $dbh->do("UNLOCK TABLES");
 178         return $s;
 179 }
 180
 181 sub get_song_random_recent() {
 182         no integer;
 183         my $s = undef;
 184
 185         my $r = rand();
 186         warn "recent rand $r $conf{recent_prob}\n";
 187         $r < $conf{recent_prob} or return undef;
 188
 189         my $sth = $dbh->prepare(
 190                 "SELECT artist.name as artist, album.name as album,song.*,".
 191                 " (unix_timestamp(now()) - unix_timestamp(time_added) < ?) as r".
 192                 " FROM song".
 193                 " LEFT JOIN artist ON artist.id=song.artist_id" .
 194                 " LEFT JOIN album ON album.id=song.album_id" .
 195                 " WHERE present AND filename LIKE '/%' AND" .
 196                 " (unix_timestamp(now()) - unix_timestamp(time_added) < ?" .
 197                 "  OR (last_played=0 AND unix_timestamp(now()) - unix_timestamp(time_added) < ?))" .
 198                 " AND unix_timestamp(now()) - unix_timestamp(last_played) > ? AND" .
 199                 " random_pref > 0" .
 200                 " ORDER BY r desc, rand() LIMIT 1"
 201         );
 202         $sth->execute($conf{recent_age} * 86400,
 203                 $conf{recent_age} * 86400,
 204                 $conf{recent_age_never_played} * 86400,
 205                 $conf{min_random_time})
 206                 or return undef;
 207         $s = $sth->fetchrow_hashref or return undef;
 208
 209         warn "playing recent $s->{filename}\n";
 210         $s->{type} = 'r';
 211         $s->{user} = '';
 212         return $s;
 213 }
 214
 215 sub select_song_random() {
 216         my $s = undef;
 217
 218         my $min = $conf{min_random_time};
 219         my $where = "present AND filename LIKE '/%' AND " .
 220                     "unix_timestamp(now()) - unix_timestamp(last_played) > ?";
 221
 222         my $ordermult = $conf{ignore_random_pref}? "" : "*pow(random_pref/?,1/?)";
 223         if($conf{random_boost_by_years_since_last_play}) {
 224                 $ordermult .= "* if(last_played, round((unix_timestamp(now()) - unix_timestamp(last_played)) / 86400 / 365 + 0.5), 1)";
 225         }
 226         my $sth = $dbh->prepare(
 227                 "SELECT artist.name as artist, album.name as album,song.* FROM song " .
 228                 "LEFT JOIN artist ON artist.id=song.artist_id " .
 229                 "LEFT JOIN album ON album.id=song.album_id " .
 230                 "WHERE $where AND random_pref > 0 " .
 231                 "ORDER BY rand() $ordermult DESC LIMIT 1");
 232
 233         for(; $min > 0; $min >>= 1, warn "no random song found, retrying with min_random_time=$min\n") {
 234                 if($conf{ignore_random_pref}) {
 235                         $sth->execute($min)
 236                                 or next;
 237                 } else {
 238                         my ($sum_pref, $count) = $dbh->selectrow_array(
 239                                 "SELECT sum(random_pref),count(*) FROM song WHERE $where", undef, $min)
 240                                 or next;
 241                         $sth->execute($min, $sum_pref, $count)
 242                                 or next;
 243                 }
 244                 $s = $sth->fetchrow_hashref
 245                         and last;
 246         }
 247         $s or return undef;
 248
 249         warn "selecting random $s->{filename} (pref $s->{random_pref}) (last played $s->{last_played})\n";
 250         return $s;
 251 }
 252
 253 sub validate_song_random($) {
 254         my ($song) = @_;
 255         my $s = undef;
 256
 257         $song or return undef;
 258         my $min = $conf{min_random_time};
 259         my $where = "song.id=? AND present AND filename LIKE '/%' AND " .
 260                     "unix_timestamp(now()) - unix_timestamp(last_played) > ?";
 261
 262         my $sth = $dbh->prepare(
 263                 "SELECT artist.name as artist, album.name as album,song.* FROM song " .
 264                 "LEFT JOIN artist ON artist.id=song.artist_id " .
 265                 "LEFT JOIN album ON album.id=song.album_id " .
 266                 "WHERE $where");
 267
 268         $sth->execute($song->{id}, $min)
 269                 or return undef;
 270         $s = $sth->fetchrow_hashref
 271                 or return undef;
 272
 273         warn "playing random $s->{filename} (pref $s->{random_pref}, last_played $s->{last_played})\n";
 274         $s->{type} = 'R';
 275         $s->{user} = '';
 276
 277         return $s;
 278 }
 279
 280 sub update_preload() {
 281         local *PRELOAD;
 282
 283         $conf{preloadfile} or return;
 284
 285         my $sth = $dbh->prepare(
 286                 "SELECT song.id, song.filename, artist.name, album.name," .
 287                 "       song.track, song.title, song.length, song.encoding" .
 288                 " FROM song" .
 289                 " LEFT JOIN artist ON artist.id=song.artist_id" .
 290                 " LEFT JOIN album ON album.id=song.album_id" .
 291                 " WHERE present AND filename LIKE '/%' AND" .
 292                 " unix_timestamp(now()) - unix_timestamp(last_played) > $conf{min_random_time}" .
 293                 " ORDER BY rand()*random_pref DESC LIMIT 10"
 294         );
 295
 296         $sth->execute() or return;
 297         open PRELOAD, ">$conf{preloadfile}" or return;
 298         my (@s);
 299         while(@s = $sth->fetchrow_array) {
 300                 printf PRELOAD "%s\n", join("\t", @s);
 301                 warn "add to preload: $s[1]\n";
 302         }
 303         close PRELOAD;
 304
 305         warn "update preload $conf{preloadfile}\n";
 306         delete $conf{preloadfile};
 307 }
 308
 309 sub get_song_preload() {
 310         my $s = undef;
 311
 312         @preload or do {
 313                 warn "no preloads available\n";
 314                 return undef;
 315         };
 316
 317         ($s->{id}, $s->{filename}, $s->{artist}, $s->{album}, $s->{track},
 318          $s->{title}, $s->{length}, $s->{encoding}) = split /\t+/, shift @preload;
 319         $s->{type} = "P";
 320         $s->{user} = '';
 321
 322         warn "playing preload $s->{filename}\n";
 323
 324         return $s;
 325 }
 326
 327 sub logprintf($@) {
 328         my ($fmt, @args) = @_;
 329
 330         # write to log file
 331         if(open LOG, ">>$conf{logfile}") {
 332                 printf LOG "%s $fmt\n", scalar localtime, @args;
 333                 close LOG;
 334         } else {
 335                 warn "cannot open logfile $conf{logfile}: $!\n";
 336         }
 337 }
 338
 339 sub update_log($$;$$$) {
 340         my ($id, $time, $reason, $result, $prevplaytime) = @_;
 341
 342         my $q = "REPLACE INTO log SET id=?, playtime=from_unixtime(?)";
 343         my @q = ($id, $time);
 344         if(defined $reason) { $q .= ", reason=?"; push @q, $reason; }
 345         if(defined $result) { $q .= ", result=?"; push @q, $result; }
 346         if(defined $prevplaytime) { $q .= ", prevplaytime=?"; push @q, $prevplaytime; }
 347         $dbh->do($q, undef, @q);
 348 }
 349
 350 sub exec_prog(;$$$) {
 351         my ($prog, $pause, $convert24to32) = @_;
 352
 353         if($pause) {
 354                 $paused = 1;
 355         }
 356         if(($pid = fork) == 0) {
 357                 # get our own program group so our parent can kill us easily
 358                 setpgrp;
 359
 360                 # restore broken pipe behavior
 361                 $SIG{'PIPE'} = 'DEFAULT';
 362
 363                 if($convert24to32) {
 364                         if(open(STDOUT, "|-") == 0) {
 365                                 $| = 0;
 366                                 while(read STDIN, $_, 3) {
 367                                         print "\0$_";
 368                                 }
 369                                 exit;
 370                         }
 371                 }
 372
 373                 if($pause) {
 374                         warn "pausing output\n";
 375                         player_cmd("waitbufferempty", "pause") or warn "error pausing output\n";
 376                 }
 377
 378                 if(defined $prog) {
 379                         exec @$prog;
 380                         die "exec $prog->[0] failed: $!\n";
 381                 }
 382         }
 383         return $pid;
 384 }
 385
 386 sub play_mplayer(@) {
 387         my @prog = @_;
 388         local *F;
 389
 390         exec_prog and return;
 391
 392         # open duplicate of stdout
 393         open F, ">&STDOUT";
 394         # no close-on-exec
 395         fcntl F, F_SETFD, 0;
 396
 397         open STDIN, "/dev/null";
 398 #       open STDERR, ">/dev/null";
 399         open STDOUT, ">&STDERR";
 400         delete $ENV{http_proxy};
 401
 402         if($prog[$#prog] =~ /^http:/) { unshift @prog, "-cache", 512; }
 403
 404         if(exists $conf{fifofile}) {
 405                 if(! -p $conf{fifofile}) {
 406                         warn "### mkfifo -m 0777 $conf{fifofile}\n";
 407                         system "mkfifo", "-m", "0777", $conf{fifofile};
 408                 }
 409                 unshift @prog, "-input", "file=$conf{fifofile}";
 410         }
 411
 412         my $samplefreq = $conf{samplefreq} || 44100;
 413         my $bits = $conf{bitspersample} || 16;
 414         unshift @prog, "mplayer", "-quiet", "-vc", "dummy", "-vo", "null",
 415                 "-noconsolecontrols",
 416                 "-af", "resample=$samplefreq,channels=2,format=s${bits}ne",
 417                 "-ao", "pcm:nowaveheader:file=/dev/fd/" . fileno(F);
 418
 419         warn "running: " . join(" ", @prog) . "\n";
 420         exec @prog;
 421         die "$prog[0]: $!\n";
 422 }
 423
 424
 425 sub play_mp3($) {
 426         no integer;
 427         my ($song) = @_;
 428
 429         my $samplefreq = $conf{samplefreq} || 44100;
 430         my $bits = $conf{bitspersample} || 16;
 431         my @madplay = qw"madplay --ignore-crc -Soraw:-";
 432         push @madplay, "-R$samplefreq";
 433         push @madplay, "-b$bits" if $bits != 16;
 434         push @madplay, "--replay-gain=$conf{replaygain}", "-a0" if exists $conf{replaygain};
 435         if($dbh) {
 436                 my $gainrec = $dbh->selectrow_hashref("SELECT gain FROM song WHERE id=$song->{id}");
 437                 if($gainrec->{gain}) {
 438                         push @madplay, "-a", ($gainrec->{gain} / 1000);
 439                 }
 440         }
 441         push @madplay, $song->{filename};
 442         exec_prog \@madplay;
 443 }
 444
 445
 446 sub play_sox($) {
 447         my ($song) = @_;
 448
 449         my $samplefreq = $conf{samplefreq} || 44100;
 450         my $bits = $conf{bitspersample} || 16;
 451         my @sox = ("sox", "-V3", $song->{filename}, "-traw", "-b$bits", "-esigned-integer", "-", "rate", "-v", $samplefreq);
 452         exec_prog \@sox;
 453 }
 454
 455
 456 sub start_play($) {
 457         my ($song) = @_;
 458         my $filename = $song->{filename};
 459
 460         # get file type
 461         $filename =~ /([^.]*)$/;
 462         my $ext = lc($1);
 463
 464         my $samplefreq = $conf{samplefreq} || 44100;
 465         my $bits = $conf{bitspersample} || 16;
 466
 467         # if fifo support is enabled, leave long songs to mplayer so we can skip forward and backward
 468         my $prefer_mplayer = exists $conf{fifofile} && $song->{length} > 600;
 469
 470         if($filename =~ /^cdda:[^:]*:(\d+)/) {
 471                 exec_prog ["$conf{cdda_prog} $1"];
 472         } elsif($ext =~ /^(wav|flac)$/ && exists $soxformats{$ext} && !$prefer_mplayer) {
 473                 play_sox($song);
 474         } elsif($ext =~ /^mp[123]$/ && $samplefreq <= 65535 && !$prefer_mplayer) {
 475                 # madplay cannot resample to >65535Hz, so we need mplayer for that
 476                 play_mp3($song);
 477         } elsif($filename =~ /^\w+:/ || $ext =~ /^(wma|wav|m4a|ape|aiff|flac|aac|ac3|ogg|shn|mp[23cp+])$/ || $song->{encoding} =~ /RealAudio/) {
 478                 play_mplayer($filename);
 479         } elsif($ext =~ /^(mid|rcp|r36|g18|g36|mod)$/) {
 480                 if($bits == 16) {
 481                         exec_prog ["timidity", "-s", $samplefreq, "-o", "-", "-Or1Ssl", $filename];
 482                 } else {
 483                         exec_prog ["timidity", "-s", $samplefreq, "-o", "-", "-Or2Ssl", $filename], undef, 1;
 484                 }
 485         } elsif($ext eq "raw") {
 486                 # assume that 'raw' means: 44100Hz, 16-bit, stereo
 487                 play_mplayer("-demuxer", "rawaudio", "-rawaudio", "channels=2:rate=44100:samplesize=2", $filename);
 488         } elsif($ext =~ /^(mpe?g|m2v|avi|asx|asf|vob|wmv|ra?m|ra|mov|mp4|flv)$/) {
 489                 exec_prog ["soepkiptng_video", $filename], 1;
 490         } else {
 491                 warn "no player for .$ext files.\n";
 492         }
 493 }
 494
 495 sub get_statusfile {
 496         open F, $conf{statusfile} or return;
 497         chop(my @f = <F>);
 498         close F;
 499         return @f;
 500 }
 501
 502 sub mpd_get_status($) {
 503         my $host = shift @_;
 504
 505         my $s = IO::Socket::INET->new("$host:2222") or return;
 506         $_ = <$s>;
 507         $s->print("status\n");
 508         $_ = <$s>;
 509         $s->close;
 510         /\brunning=(\d+)\b.*\bsong=(\d+)\b.*\btime=(\d+)\b/ or return;
 511         return ($1, $2, $3);
 512 }
 513
 514 sub mpd_soepkip_status {
 515         my (undef, $filename, undef, undef, $host, undef, undef, undef, $ar, $t, $al, $tr, $len) = get_statusfile();
 516         my ($running, $songno, $time) = mpd_get_status($host);
 517         $running = $running? "play" : "pause";
 518         return <<EOF;
 519 repeat: 0
 520 random: 0
 521 single: 0
 522 consume: 0
 523 playlist: 0
 524 playlistlength: 1
 525 xfade: 0
 526 state: $running
 527 time: $time:$len
 528 EOF
 529 }
 530
 531 sub mpd_soepkip_currentsong {
 532         my (undef, $filename, undef, undef, $host, undef, undef, undef, $ar, $t, $al, $tr, $len) = get_statusfile();
 533         $filename =~ s|.*/||;
 534         $ar =~ s/\s+$//;
 535         $t =~ s/\s+$//;
 536         $al =~ s/\s+$//;
 537         if(length("$ar $t $al") > 65) {
 538                 if(length($al) > 21) {
 539                         $al = substr($al, 0, 20) . "\\";
 540                 }
 541                 if(length("$ar $t $al") > 65) {
 542                         if(length($ar) > 21) {
 543                                 $ar = substr($ar, 0, 20) . "\\";
 544                         }
 545                         if(length("$ar $t $al") > 65) {
 546                                 if(length($t) > 21) {
 547                                         $t = substr($t, 0, 20) . "\\";
 548                                 }
 549                         }
 550                 }
 551         }
 552         return <<EOF;
 553 file: $filename
 554 Time: $len
 555 Artist: $ar
 556 Title: $t
 557 Album: $al
 558 Track: $tr
 559 EOF
 560 }
 561
 562 sub mpd_accept($) {
 563         my ($lsock) = @_;
 564         if(fork == 0) {
 565                 alarm 10;
 566                 my ($sock, $paddr) = $lsock->accept or die "accept mpdsock: $!\n";
 567                 $lsock = undef; # prevent "address already in use" if parent is restarted
 568                 my ($port, $iaddr) = sockaddr_in($paddr);
 569                 my $name = inet_ntoa($iaddr);
 570                 warn "pid $$ got MPD connection from $name:$port\n";
 571                 $sock->print("OK MPD 0.1.0\n");
 572                 alarm 0;
 573                 while(<$sock>) {
 574                         if(/^status/) {
 575                                 $sock->print(mpd_soepkip_status());
 576                                 $sock->print("OK\n");
 577                         } elsif(/^currentsong/) {
 578                                 $sock->print(mpd_soepkip_currentsong());
 579                                 $sock->print("OK\n");
 580                         } else {
 581                                 $sock->print("ACK [5\@0] {} unknown command \"bla\"\n");
 582                         }
 583                 }
 584                 exit;
 585         }
 586 }
 587
 588 sub perish {
 589         my ($sig) = @_;
 590
 591         unlink $conf{statusfile};
 592         $dbh and $dbh->disconnect;
 593         warn "got SIG$sig, kill -KILL -$pid and $cdrplaypid, exiting\n";
 594         kill 'KILL', -$pid, $cdrplaypid;
 595         exit;
 596 };
 597
 598 getopts('dr:s:c:');
 599 my $debug = 1 if $opt_d;
 600
 601 read_configfile(\%conf, $opt_c);
 602
 603 $ENV{PATH} = "$progdir/bin:$ENV{PATH}";
 604
 605 if(open ST, $conf{statusfile}) {
 606         my ($s, $f, $pid) = <ST>;
 607         close ST;
 608         $pid = 0 + $pid;
 609         if($pid) {
 610                 kill 0, $pid
 611                         and die "Another copy of soepkiptngd is already running! (pid $pid)\n";
 612         }
 613 }
 614
 615 my $killsock = IO::Socket::INET->new(Listen => 5)
 616         or die "cannot create listening TCP socket: $!\n";
 617 my $killhost = hostname;
 618 my $killport = $killsock->sockport();
 619
 620 my $mpdport = $conf{mpd_port} || 6600;
 621 my $mpdsock;
 622 if($mpdport) {
 623         $mpdsock = IO::Socket::INET->new(Proto => "tcp", LocalPort =>$mpdport, ReuseAddr => 1, Listen => 5)
 624                 or die "cannot open listening socket on port $mpdport: $!\n";
 625 }
 626
 627 unless($debug) {
 628         if(!$opt_r) {
 629                 fork && exit;
 630                 chdir "/";
 631                 setpgrp();
 632         }
 633         open STDIN, "</dev/null";
 634         open STDERR, ">>$conf{errfile}" or do {
 635                 rotatelog(1);
 636                 open STDERR, ">$conf{errfile}" or die "$conf{errfile}: $!\n";
 637                 warn "logs rotated prematurely because of permission problems.\n";
 638         };
 639         STDERR->autoflush(1);
 640         $SIG{__DIE__} = \&dierotate;
 641         $SIG{__WARN__} = \&warnrotate;
 642 }
 643 sleep $opt_s if $opt_s;
 644
 645 warn sprintf "*** starting soepkiptngd (pid=$$) %s ***\n", '$Id$';
 646 warn "PATH=$ENV{'PATH'}\n";
 647
 648 $SIG{'TERM'} = \&perish;
 649 $SIG{'INT'} = \&perish;
 650
 651 $SIG{'USR1'} = sub {
 652         warn "setting restart flag\n";
 653         $restart = 1;
 654 };
 655
 656 $SIG{'PIPE'} = 'IGNORE';
 657
 658 if($conf{preloadfile}) {
 659         local *PRELOAD;
 660
 661         if(open PRELOAD, $conf{preloadfile}) {
 662                 chop(@preload = <PRELOAD>);
 663                 close PRELOAD;
 664                 warn "preload: added " . scalar @preload . " songs.\n";
 665         } else {
 666                 warn "$conf{preloadfile}: $!\n";
 667         }
 668 }
 669
 670 if($opt_r) {
 671         $cdrplaypid = $opt_r;
 672         warn "cdrplaypid=$cdrplaypid (from -r)\n";
 673 } else {
 674         # just to be sure to avoid sending pcm data to the terminal
 675         open STDOUT, ">/dev/null";
 676
 677         # when $playercmd fails instantly, we might get SIGCHLD
 678         # before $cdrplaypid is set !!!
 679         $cdrplaypid = open STDOUT, "|$conf{playercmd}"
 680                 or die "failed to start $conf{playercmd}: $!\n";
 681         warn "cdrplaypid=$cdrplaypid\n";
 682
 683         # play 2 sec. of silence to get my external DAC going
 684         print "\0"x352800;
 685 }
 686
 687 # we might have missed the exiting of cdrplay, so reap once now
 688 child_reaper();
 689
 690
 691 open F, "sox --help-format all|";
 692 while(<F>) {
 693         /^Format:\s*(\S+)/ and $soxformats{$1} = 1;
 694 }
 695 close F;
 696
 697
 698 srand;
 699
 700 my $num_errors = 0;
 701 my ($killsock_conn);
 702 for(;;) {
 703         my ($song, $childtime);
 704
 705         if($restart) {
 706                 # close-on-exec apparently doesn't work
 707 #               $dbh->disconnect;
 708                 $killsock_conn and $killsock_conn->close();
 709                 $killsock->close();
 710                 unlink $conf{statusfile};
 711
 712                 warn "execing myself\n";
 713                 exec "$progdir/soepkiptngd", '-r', $cdrplaypid;
 714                 die "$progdir/soepkiptngd: $!\n";
 715         }
 716
 717         if($num_errors > 1) {
 718                 # exponential backoff in retries, max 1024 sec. (17 min 4 s)
 719                 sleep 1 << ($num_errors < 10? $num_errors : 10);
 720         }
 721
 722         # (re)open database connection if necessary
 723         if(!$dbh || !$dbh->ping) {
 724                 $dbh = DBI->connect("DBI:mysql:$conf{db_name}:$conf{db_host}",
 725                         $conf{db_user}, $conf{db_pass}) or warn
 726                                 "Can't connect to database $conf{db_name}" .
 727                                 "\@$conf{db_host} as user $conf{db_user}\n";
 728         }
 729
 730         if($dbh) {
 731                 $song = get_song_jingle() || get_song_queued() || get_song_random_recent() or do {
 732                         $randsong = validate_song_random($randsong);
 733                         if($randsong) {
 734                                 $song = $randsong;
 735                                 $randsong = undef;
 736                         } else {
 737                                 $song = select_song_random() or do {
 738                                         $num_errors++;
 739                                         next;
 740                                 }
 741                         }
 742                 };
 743
 744                 # random lookup can take a few sec; maybe a jingle/queued song
 745                 # has been added in the meantime (these lookups are very fast)
 746                 if($song->{type} =~ /r/i) {
 747                         my $s = get_song_jingle() || get_song_queued();
 748                         $song = $s if $s;
 749                 }
 750
 751                 if($song->{id}) {
 752                         # update database
 753                         $dbh->do("UPDATE song set last_played=NULL where id=$song->{id}");
 754
 755                         update_preload();
 756                 } else {
 757                         warn "no song found.\n";
 758                         $dbh->disconnect;
 759                         $dbh = undef;
 760                         $num_errors++;
 761                         next;
 762                 }
 763         } else {
 764                 $song = get_song_preload() or do {
 765                         $num_errors++;
 766                         next;
 767                 };
 768         }
 769
 770         # write to log file
 771         logprintf("%s %6d %s", $song->{type}, $song->{id}, $song->{filename});
 772
 773         # write to log table
 774         $song->{playtime} = time;
 775         update_log($song->{id}, $song->{playtime}, $song->{type}, undef, $song->{last_played});
 776
 777         # write status file
 778         my $status = <<EOF;
 779 $song->{id}
 780 $song->{filename}
 781 $$
 782 $cdrplaypid
 783 $killhost
 784 $killport
 785 $song->{type}
 786 $song->{user}
 787 $song->{artist}
 788 $song->{title}
 789 $song->{album}
 790 $song->{track}
 791 $song->{length}
 792 $song->{encoding}
 793 EOF
 794         if(open ST, ">$conf{statusfile}.tmp") {
 795                 print ST $status;
 796                 close ST;
 797                 rename "$conf{statusfile}.tmp", $conf{statusfile}
 798                         or warn "cannot rename $conf{statusfile}.tmp -> $conf{statusfile}: $!\n";
 799         } else {
 800                 warn "cannot open statusfile $conf{statusfile}: $!\n";
 801         }
 802
 803         # close accepted socket after statusfile was updated
 804         if($killsock_conn) {
 805                 print $killsock_conn $status;
 806                 $killsock_conn->shutdown(2); # in case a child process still has it open
 807                 $killsock_conn->close();
 808                 undef $killsock_conn;
 809         }
 810
 811         # reset time counter
 812         warn "kill -ALRM $cdrplaypid\n";
 813         kill 'SIGALRM', $cdrplaypid
 814                 or warn "kill -ALRM $cdrplaypid: $!\n";
 815
 816         # launch player
 817         my $starttime = time;
 818         if($debug) {
 819                 my ($a, $b, $c, $d) = times;
 820                 $childtime = $c + $d;
 821         }
 822         start_play($song);
 823         warn "pid=$pid\n";
 824
 825         # update random song cache
 826         if(!$randsong) {
 827                 warn "selecting random song cache\n";
 828                 $randsong = select_song_random();
 829         }
 830
 831         # wait until player is done or we get a connect on $killsock
 832         my ($rin, $rout);
 833         vec($rin = '', $killsock->fileno(), 1) = 1;
 834         vec($rin, $mpdsock->fileno(), 1) = 1 if $mpdsock;
 835         for(;;) {
 836                 child_reaper();
 837                 last if $pid == 0;
 838                 if(select($rout = $rin, undef, undef, 0.1) > 0) {
 839                         if(vec($rout, $killsock->fileno(), 1)) {
 840                                 warn "got connection\n";
 841                                 $song->{result} = "killed";
 842
 843                                 # kill player
 844                                 my $p = $pid;
 845                                 if($p) {
 846                                         warn "kill -KILL -$p\n";
 847                                         kill 'KILL', -$p
 848                                                 or warn "kill -KILL -$p: $!\n";
 849                                 }
 850
 851                                 # tell cdrplay to flush its buffers
 852                                 warn "kill -USR1 $cdrplaypid\n";
 853                                 kill 'SIGUSR1', $cdrplaypid
 854                                         or warn "kill -USR1 $cdrplaypid: $!\n";
 855
 856                                 # accept the tcp connection; we close it later,
 857                                 # after a new song has been selected
 858                                 $killsock_conn = $killsock->accept();
 859
 860                                 # write to log file
 861                                 logprintf("K %6d", $song->{id});
 862                         }
 863                         if($mpdsock && vec($rout, $mpdsock->fileno(), 1)) {
 864                                 mpd_accept($mpdsock);
 865                         }
 866                 }
 867         }
 868
 869         if(($pid_status || $pid_signal) && !$killsock_conn) {
 870                 # write to log file
 871                 logprintf("E %6d status=%d signal=%d", $song->{id}, $pid_status, $pid_signal);
 872
 873                 $song->{result} = sprintf("error: status=%d signal=%d", $pid_status, $pid_signal)
 874                         unless $song->{result};
 875                 $num_errors++;
 876         } else {
 877                 $song->{result} = "finished" unless $song->{result};
 878                 $num_errors = 0;
 879         }
 880
 881         # write to log table
 882         update_log($song->{id}, $song->{playtime}, $song->{type}, $song->{result}, $song->{last_played});
 883
 884         if($debug) {
 885                 my ($a, $b, $c, $d) = times;
 886                 $childtime = $c + $d - $childtime;
 887                 warn "song finished, time=$childtime\n";
 888         }
 889
 890         # delete jingle files
 891         delete_jingles();
 892
 893         # prevent us from eating 100% cpu time in case of misconfiguration
 894         time == $starttime and $num_errors++;
 895 }
 896