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