#!/usr/bin/perl -w
# audiofs --- simulates a file system, generating m3u and .mp3 files as needed.
# Copyright © 2001-2013 Jamie Zawinski <jwz@dnalounge.com>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Created: 21-Oct-99.

# http://cerebrum.dnalounge.com:8001/archive/audio/2001/06-16-210004.m3u
# refers to a file /home/archive/2001/06-16.mp3 starting at 21:00:04.
#
# http://cerebrum.dnalounge.com:8001/archive/audio/blah-blah-blah-000000.m3u
# refers to a file /home/archive/permanent/blah-blah-blah.mp3.


require 5;
use diagnostics;
use strict;
use POSIX qw(strftime);

BEGIN { push @INC, "/var/www/dnalounge/utils/"; }
use Menuify;  # DNA::Menuify
DNA::Menuify->import qw(error url_unquote);

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.120 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $verbose = 0;

my $allow_random_access = 1;
my $max_listeners = 50;          # only allow this many simultanious listeners

$max_listeners = -1; ## MacOS has no "pidof"...

my $max_age = 16;	# don't allow playback if older than this many days

my $names_file = "/var/www/dnalounge/calendar/names.txt";



my $stream_title = "DNA Lounge";
my $extra_headers = join ("\r\n",	# header names are case-sensitive!
   ("x-audiocast-location: $stream_title",
    "x-audiocast-admin: webmaster\@dnalounge.com",
    "x-audiocast-server-url: http://www.dnalounge.com/audio/",
    "x-audiocast-url:http://www.dnalounge.com/audio/",
    "x-audiocast-bitrate:%BITRATE%",
    "x-audiocast-public:0",
    "icy-pub:0",
    ));

my $data_dir = "/home/archive";
my $perm_dir = "$data_dir/permanent";
my $exec_dir = $data_dir;

my $slowcat = "$exec_dir/slowcat";

# IPs that match this re are immune to connection limits
my $auth_addr = undef;
#$auth_addr = '^70\.36\.236\.109$';


sub this_url() {
  my $url = "http://";
  if ($ENV{HTTP_HOST}) {
    $url .= $ENV{HTTP_HOST};
  } else {
    $url .= $ENV{SERVER_NAME};
    $url .= ":" . $ENV{SERVER_PORT} unless ($ENV{SERVER_PORT} eq '80');
  }
  $url .= $ENV{REQUEST_URI};
# $url =~ s/-\d\d?[-:]?\d\d[-:]?\d\d(\.[a-z\d]+)$/$1/i;
  return $url;
}


my %event_names;

sub pull_names() {

  if (-f $names_file) {
    print STDERR "$progname: reading $names_file...\n" if ($verbose);
    open (my $in, '<', $names_file) || 
      error ("$names_file: $!", "500 Internal Error");
    local $/ = undef;  # read entire file
    my $body = <$in>;
    close $in;

    my $count = 0;
    foreach my $line (split(/\n/, $body)) {
      my ($date, $pres, $name) = split(m/\t/, $line);
      #error ("$names_file: unparsable: $line") unless ($name);
      $name =~ s/^\*//s;
      $event_names{$date} = $name;
      $count++;
    }
    #error ("$nf: no names") unless $count;
    print STDERR "$progname: $count names\n" if ($verbose > 2);
  }
}


# Runs id3info to find the true bitrate of the file.
#
sub file_kbps($) {
  my ($file) = @_;
  my $f2 = $file;
  $f2 =~ s@([^-_./a-z\d])@\\$1@gsi;
  my $cmd = "id3info $f2";
  my $res = `($cmd) 2>&1`;
  if ($res =~ m/Bitrate: (\d+)KBps/si) {
    return $1;
  }
  return 128;
}


sub path_info_to_file() {

  my $file;
  my @st;

  $_ = $ENV{PATH_INFO};
  my ( $year, $month, $day, $idx, $hour, $min, $sec, $ext ) =
    m@^/(\d\d\d\d)/			# YYYY/
        (\d\d)-(\d\d)			# MM-DD
        [-.:]?([a-z]?)			# b
        (?:
        -
        (\d\d?)[-:]?(\d\d)[-:]?(\d\d)	# HH:MM:SS
        )?
        \.(mp3|m3u|pls|pbm|png|gif)$	# .EXT
     @xi;

  my $title = undef;

  if (defined($year) && defined($ext)) {

    $hour = 0 unless defined($hour);
    $min  = 0 unless defined($min);
    $sec  = 0 unless defined($sec);

    $ext = 'mp3' if ($ext =~ m/m3u|pls/);
    $file = "$data_dir/$year/$month-$day$idx.$ext";
    @st = stat($file);

  } else {   # maybe there's a perma-url?

    $file = undef;

    s@^/@@;
    my $filename = $_;

    ($filename, $ext) = m@^(.*?)\.(mp3|m3u|pls)$@;
    if ($ext) {
      $filename = url_unquote ($filename);
      my $f2;
      $_ = $filename;
      ($f2, $hour, $min, $sec) =
        m@^(.*?)-
           (\d\d?)[-:]?(\d\d)[-:]?(\d\d)$	# HH:MM:SS
         @xi;

      if (defined ($f2)) {
        $filename = $f2;
      } else {
        $hour = $min = $sec = 0;
      }

      if ($filename =~ m@^[-a-z\d_/\' ]+$@si) {
        $title = $filename;
        $title =~ s@/@: @gs;
        $title =~ s@[-._]@_@gs;

        $file = "$perm_dir/$filename.mp3";
        @st = stat($file);
        $file = "$filename.mp3" if (! $st[7]); # better error msg
      }
    }
  }

# my $url = this_url();
  my $url = $ENV{REQUEST_URI};

  error ("unparsable URL: $url", "400 Bad Request")
    unless (defined ($file) && defined($ext));

  my $kbps = file_kbps ($file);
  my $bytes_per_second = $kbps * 125;  # 128 = 16000

  my $secs = (($hour * 60 * 60) + ($min * 60) + $sec);
  my $start_byte = $secs * $bytes_per_second;

  my $img_p = ($file =~ m/\.(gif|pbm|png)$/s);

  my $size = $st[7];
  my $date = $st[9];
  error ("$url does not exist", "404 Not Found") unless defined($size);
  error ("$url is empty",       "410 Gone")
    unless ($size > $bytes_per_second || $img_p);

  if ($start_byte + $bytes_per_second >= $size && !$img_p) {
    my $len = int($size / $bytes_per_second);
    error (sprintf ("can't start at %d:%02d:%02d -- " .
                    "file is only %d:%02d:%02d long.",
                    $hour, $min, $sec,
                    int($len / (60 * 60)),
                    int($len / 60) % 60,
                    ($len % 60)),
           "400 Bad Request");
  }

  pull_names();
  my $key = $year ? "$year-$month-$day$idx" : '';
  my $blurb = $event_names{$key} || $key || $title || '';

  my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
                "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
  $month = $months[$month-1] if (defined ($month));

  $blurb = "$day-$month-$year: $blurb" if (defined ($year));
  $blurb =~ s@[- :]*$@@s;

  $blurb = $stream_title . ($blurb ? ": $blurb." : "");

  if ($secs) {
    $title .= sprintf(" (+%d:%02d:%02d)", $hour, $min, $sec);
  }

  return ($file, $start_byte, $size, $date, $blurb, $kbps);
}


sub stream_file() {

#  if ($ENV{REMOTE_ADDR} eq '70.36.236.109') {
#    foreach (sort keys(%ENV)) {
#      print STDERR "#### $_ = " . $ENV{$_} . "\n";
#    }
#  }

  my ($file, $start_byte, $end_byte, $date, $title, $kbps) =
    path_info_to_file();
  my $range_start = undef;
  my $range_end   = undef;

  my $metaint = 0;

  my $permanent_p = ($file =~ m/^\Q$perm_dir/o);
  my $random_p = ($permanent_p || $allow_random_access);
  my $audio_headers_p = 1;

  # If the client says they can handle metadata, send it.
  # If we send it when it's not expected, we get audio glitches.
  #
  # iTunes, of course, makes this more complicated by not telling us whether
  # it can handle metadata or not.  Sometimes it can, sometimes it can't.
  #
  # If iTunes considers this to be a "stream" then it supports ICY metadata.
  # If it considers it to be a "file" then it does not support ICY and we
  # have to send an ID3 tag instead.
  #
  # If the URL ends in ".mp3", iTunes goes into "file" mode and we must not
  # send ICY or we get audio glitches.
  #
  # However, even in the case where iTunes is in an ICY-accepting mood, it
  # does not send the "icy-metadata" header requesting it so that we can tell!
  # We're expected to just know.  Thanks guys.
  #
  if (defined ($ENV{HTTP_USER_AGENT}) && 
      $ENV{HTTP_USER_AGENT} =~ m@^iTunes/@) {
    if (! ($ENV{REQUEST_URI} =~ m@\.mp3$@i)) {
      $ENV{HTTP_ICY_METADATA} = 1;
    }
  }

  if ((defined ($ENV{HTTP_ICY_METADATA}) && 
       $ENV{HTTP_ICY_METADATA} ne '0')) {
    $metaint = $kbps * 125;  # 128 = 16000, about once a second
  }

  my $ct = 'audio/mpeg';
  my $length = $end_byte - $start_byte;

  # Kludge for the histogram images
  if ($file =~ m/\.(gif|pbm|png|p?jpe?g)$/s) {
    $ct = "image/$1";
    $random_p = 1;
    $permanent_p = 1;
    $audio_headers_p = 0;
    $metaint = 0;
    $slowcat = undef;
  }

  # Now we also have to estimate how much space the metadata will
  # take up to get the content-length to be right... if it's too
  # short, iTunes cuts off the end.
  #
  if ($metaint) {
    my $mdl = length($title) + 12;
    $mdl = int (($mdl + 16) / 16) * 16;
    $length += $mdl;
  }

  my $headers = "";

  $headers .= "Content-Type: $ct\r\n";

  $headers .= "Last-Modified: " .
    strftime ("%a, %d %b %Y %T GMT", gmtime($date)) . "\n";


  {
    my $http_range = $ENV{HTTP_RANGE};
    if ($http_range) {
      if ($http_range =~ m/^bytes=(\d*)-(\d*)$/) {
        #
        # 0-0 means return the first byte.
        # 0-1 means return the first two bytes.
        # 0-  is the same as 0-0.
        # 1-  is the same as 1-1.
        #
        $range_start = $1 || 0;		# treat invalid "-N" as "0-N".
        $range_end   = $2;
        $range_end = $range_start if ($range_end eq '');
        if ($range_end > $length) {
          error ("Range out of range: ($range_end > $length)",
                 "416 Requested Range Not Satisfiable");
        }
      } else {
        error ("unparsable Range header: $http_range",
               "400 Bad Request");
      }
    }
  }

  my $cl = $length;

  if ($random_p) {
    $headers .= "Accept-Ranges: bytes\r\n";

    # The Content-Length header is always the length of the data actually sent.
    if (defined($range_start) || defined($range_end)) {
      $cl = $range_end - $range_start + 1;
    }

    # Always return 206 instead of 200 if there's a range-start, even if
    # the range covers the entire file.  200 would also be appropriate there,
    # but maybe some things get confused?
    #
    if (defined ($range_start)) {
      my $re = $range_end;
      # Need both 206 and Content-Range for WinAmp to do the right thing.
      $headers = "Status: 206 Partial Content\r\n" . $headers;
      $headers .= "Content-Range: bytes $range_start-$re/$length\r\n";
      $end_byte = $start_byte + $range_end;
      $start_byte += $range_start;
    }

  } else {
    $headers .= "Accept-Ranges: none\r\n";

    #
    # If random access is not allowed, and a Range: header was specified in
    # the request, then return an error.
    #
    if ($range_start) {
      error ("random-access not permitted (Range: $ENV{HTTP_RANGE})",
             "403 Forbidden (random access not permitted)");
    }

    # Don't emit a Content-Length header, because if we do, then WinAmp assumes
    # that it's a seekable stream, and will display a slider.  When the user
    # bonks the slider, they re-get the URL with a Range: header to seek.
    #
    # They do this EVEN IF we say "Accept-Ranges: none".  If we send that
    # header, then their client should be unwilling to send Range:, but it
    # does anyway.  That's wrong.
    #
    $cl = undef;
  }

  $headers .= "Content-Length: $cl\r\n" if (defined ($cl));

  # Kludge
  $title =~ s/DNA Lounge: flightriskradio:[ \d]+/Flight Risk Radio: /gsi;

  if ($audio_headers_p) {
    $headers .= ("x-audiocast-name: $title\r\n" . # case-sensitive header name!
                 "icy-name:$title\r\n" .
                 $extra_headers . "\r\n");
  }

  $headers =~ s/%BITRATE%/$kbps/gi;

  $headers .= "icy-metaint: $metaint\r\n" if ($metaint);

  $headers .= "\r\n";

  check_listener_count();
  check_file_age($file, $ENV{REQUEST_URI}) unless ($permanent_p);

  print STDOUT $headers;
  $headers = undef;

  if (defined ($cl) && $cl == 0) {	# request for null data.
    return;
  }

  if ($slowcat) {
    #
    # Overlay this process with the "slowcat" program.
    #
    my @args = ( "--burst", 5,
                 "--bps", $kbps . "k",
                 "--range", $start_byte, $end_byte + 1,
                 "--title", $title,
               );
    push @args, "--id3" unless $metaint;
    push @args, ("--icy", $metaint) if $metaint;

    push @args, $file;

    unshift @args, "--verbose" if ($verbose);

    print STDERR "$progname: exec: $slowcat " . join(' ', @args) . "\n"
      if ($verbose);

    exec { $slowcat } ($slowcat, @args );
    die "$progname: exec $slowcat failed: $?\n";

  } else {
    #
    # Cat the file out at full speed.
    #
    open (my $in, '<', $file)  || die "$progname: $file: open: $?\n";
    seek ($in, $start_byte, 0) || die "$progname: $file: seek: $?\n";

    my $buf = '';
    my $n;
    do {
      $n = read ($in, $buf, 10240);
      print $buf;
    } while ($n > 0);
    close ($in);
  }
}


# If there are too many folks connected, error out.
#
sub check_listener_count() {

  return if ($max_listeners <= 0);

  if (defined ($auth_addr)) {
    my $addr = $ENV{REMOTE_ADDR};
    return if (defined($addr) && $addr =~ m/$auth_addr/o);
  }

  my $program = (defined($slowcat) ? $slowcat : $progname);
  my @pids = split(/\s+/, `/sbin/pidof -o $$ $program`);
  my $count = $#pids + 1;

  if ($count >= $max_listeners) {
    error ("Too Many Listeners: try again later!",
           "503 Too Many Listeners");
  }
}


# If this file is too old, error out.
#
sub check_file_age($) {
  my ($file, $url) = @_;

  if (defined ($auth_addr)) {
    my $addr = $ENV{REMOTE_ADDR};
    return if (defined($addr) && $addr =~ m/$auth_addr/o);
  }

  my $tt = (stat($file))[9];
  my $age_days = (time - $tt) / (60 * 60 * 24);
  error ("$url has expired", "410 Gone") if ($age_days > $max_age);
}


sub generate_playlist() {

  my ($file, $start_byte, $end_byte, $date, $title, $kbps) =
    path_info_to_file();

  my $server = ($ENV{HTTP_HOST} ? $ENV{HTTP_HOST} : $ENV{SERVER_NAME});
  error ("HTTP_HOST and SERVER_NAME are not set", "500 Internal Error")
    unless $server;
  error ("REQUEST_URI is not set", "500 Internal Error")
    unless $ENV{REQUEST_URI};
  error ("PATH_INFO is not set", "500 Internal Error")
    unless $ENV{PATH_INFO};

  my $url = "http://$server" . $ENV{REQUEST_URI};

  if ($url =~ m/^(.*)\.(pls|m3u)$/i) {
    $url = $1;

    # iTunes 10+ ignores the "x-audiocast-name" if the URL ends in ".mp3".
    # However, it does not allow seeking *unless* the URL ends in ".mp3".
    # Nice choice, isn't it?  This is why we generate an ID3v2 TIT2 tag
    # as well.
    $url .= '.mp3';

  } else {
    error ("URL does not end in PLS or M3U?", "400 Bad Request");
  }

  # Put in a port if none was present.  It turns out that some mp3
  # players (Audion) require a port number.
  #
  $url =~ s@^(http://[^:/]+)/@$1:80/@;

  my $type;
  my $body = "";

  if ( $ENV{PATH_INFO} =~ m/\.pls$/i ) {
    $type = "audio/x-scpls";
    $body .= "[playlist]\n";
    $body .= "NumberOfEntries=1\n";
    $body .= "File1=$url\n";
  } else {
    $type = "audio/mpegurl";
    $body = "$url\n";
  }

  print "Content-Type: $type\n";
  print "Content-Length: " . length($body) . "\n";
  print "Last-Modified: " .
    strftime ("%a, %d %b %Y %T GMT", gmtime($date)) . "\n";
  print "\n$body";
}


sub usage() {
  print STDERR "usage: $progname [--verbose]\n";
  exit 1;
}

sub main() {
  $|=1;

  # Only parse argv if we're not running as a CGI.
  #
  if (!defined ($ENV{REQUEST_URI})) {
    while ($_ = $ARGV[0]) {
      shift @ARGV;
      if ($_ eq "--verbose") { $verbose++; }
      elsif (m/^-v+$/) { $verbose += length($_)-1; }
      elsif (m/^-./) { usage; }
      else { usage; }
    }
  }

  # Parse the PATH_INFO (the file-system-ish bits at the end of our URL)
  # to decide how we were invoked and what kind of file we should pretend
  # to be.
  #
  if (!defined($ENV{PATH_INFO}) ||
      $ENV{PATH_INFO} eq "" ||
      $ENV{PATH_INFO} eq "/") {
    error ("no path.", "400 Bad Request");

  } else {
    my ($ext) = ($ENV{PATH_INFO} =~ m/\.([a-z\d]+)$/si);

    if (! $ext) {
      $ext = 'mp3';
      $ENV{PATH_INFO} .= ".$ext";
    }

    if ($ext =~ m/^(mp3|pbm|png|gif)$/si) {
      stream_file();
    } elsif ($ext =~ m/^(pls|m3u)$/si) {
      generate_playlist();
    } else {
      error ("bogus file extension: $ENV{PATH_INFO}", "400 Bad Request");
    }
  }
}

main();
exit 0;