soepkiptngd.sw

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