#!/usr/bin/perl -w # audiofs --- simulates a file system, generating m3u and .mp3 files as needed. # Copyright © 2001-2018 Jamie Zawinski # # 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/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/audio/blah-blah-blah-000000.m3u # refers to a file /home/archive/permanent/blah-blah-blah.mp3. # # http://cerebrum.dnalounge.com:8001/mixtape/001.m3u # refers to the files in the directory /home/archive/mixtapes/001/ # # The .txt extension returns just the title or track listing of the # archive or mixtape. # # MP3 files are streamed out in realtime using "slowcat". # # Byte ranges (seeking) is supported on all files and pseudo-files. require 5; use diagnostics; use strict; use POSIX qw(strftime); use IPC::Open3; BEGIN { push @INC, "/var/www/dnalounge/utils/"; } use Menuify; # DNA::Menuify DNA::Menuify->import (qw(error url_unquote html_quote)); my $progname = $0; $progname =~ s@.*/@@g; my ($version) = ('$Revision: 1.135 $' =~ m/\s(\d[.\d]+)\s/s); my $verbose = 0; my $debug_p = 0; my $allow_random_access = 1; my $max_age = 17; # don't allow playback if older than this many days my $names_file = "/var/www/dnalounge/calendar/names.txt"; my $archive_url = 'https://www.dnalounge.com/webcast/'; my $stream_title = "DNA Lounge"; my $mixtape_title = "jwz mixtape"; 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: $archive_url", "x-audiocast-url: $archive_url", "x-audiocast-bitrate:%BITRATE%", "x-audiocast-public:0", "icy-pub:0", "icy-url: $archive_url", )); my $archive_dir = "/home/archive"; my $perma_dir = "$archive_dir/permanent"; my $mixtape_dir = "$archive_dir/mixtapes"; my $exec_dir = $archive_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$'; 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 $def_kbps = 128; my $kbps = undef; if ($file =~ m/\.mp3$/si) { my @cmd = ('id3info', $file); my ($in, $out, $err); $err = Symbol::gensym; my $result = ''; print STDERR "$progname: exec: " . join(' ', @cmd) . "\n" if ($verbose); my $pid = eval { open3 ($in, $out, $err, @cmd) }; if ($pid) { close ($in); close ($err); local $/ = undef; # no line buffering while (<$out>) { $result .= $_; } waitpid ($pid, 0); } $kbps = $1 if ($result =~ m/Bitrate: (\d+)KBps/si); # On corrupted files, we do sometimes get "Bitrate: 0KBps". $kbps = undef if (defined($kbps) && $kbps eq '0'); error ("insane bitrate: $kbps", "500 Internal Error") if (defined($kbps) && ($kbps < 24 || $kbps > 1000)); } return ($kbps || $def_kbps); } # If this file is too old, error out. # sub check_file_age($) { my ($date) = @_; if (defined ($auth_addr)) { my $addr = $ENV{REMOTE_ADDR}; return if (defined($addr) && $addr =~ m/$auth_addr/o); } my $age_days = (time - $date) / (60 * 60 * 24); error ("Expired (" . int($age_days) . " days old)", "410 Gone") if ($age_days > $max_age); } # Parses the $PATH_INFO on the URL to determine what file we're loading # and where to start streaming it from. Handles paths of the form: # # /audio/YYYY/MM-DD.EXT # /audio/YYYY/MM-DD-HHMMSS.EXT # /audio/YYYY/MM-DD-HH:MM:SS.EXT # /audio/permanent/NAME-HH:MM:SS.EXT # /mixtape/NNN.EXT # # Returns: ($files, $start_byte, $end_byte, $date, $title, $kbps) # sub path_info_to_files() { error ("REQUEST_URI is not set", "500 Internal Error") unless $ENV{REQUEST_URI}; error ("SCRIPT_NAME is not set", "500 Internal Error") unless $ENV{SCRIPT_NAME}; # Is this script named "mixtape" or "audio"? # "/audio/YYYY/MM-DD.mp3" and "/mixtape/NNN.mp3" are different namespaces. # my $mixtape_p = ($ENV{SCRIPT_NAME} =~ m@/mixtape$@s); my @files = (); my $title = undef; my $start_secs = 0; if (!$mixtape_p) { ########################################################################## # # /audio/YYYY/MM-DD.EXT # ########################################################################## my ( $year, $month, $day, $idx, $hour, $min, $sec, $ext ) = ($ENV{PATH_INFO} =~ m@^/(\d\d\d\d) / # YYYY/ (\d\d) - (\d\d) # MM-DD [-.:]? ([a-z]?) # b (?: - (\d\d?) [-:]? (\d\d) [-:]? (\d\d) # HH:MM:SS )? (?: \. ([a-z\d]+) # .EXT )? $ @xi); if (defined($year)) { # /YYYY/MM-DD.EXT $hour = 0 unless defined($hour); $min = 0 unless defined($min); $sec = 0 unless defined($sec); $start_secs = (($hour * 60 * 60) + ($min * 60) + $sec) if defined($hour); $ext = 'mp3' if (!defined ($ext) || ($ext =~ m/^(m3u|pls|txt|asx|xspf)$/si)); @files = ("$archive_dir/$year/$month-$day$idx.$ext"); pull_names(); my $key = "$year-$month-$day$idx"; $title = $event_names{$key}; # If this is an Above DNA event ID, and we don't have a name, guess that # it is a two-room webcast and use the name of the Main Room event. # if (!$title && $key =~ m/[cd]$/s) { my $key2 = $key; $key2 =~ s/c$/a/s; # Above Early -> Main Early $key2 =~ s/d$//s; # Above Late -> Main Late $title = $event_names{$key2}; if ($title) { $title =~ s/: .*?$//s; $title .= ': Upstairs'; } } $title = $key unless $title; my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); $month = $months[$month-1] if (defined ($month)); $title = "$day-$month-$year: $title" if (defined ($year)); $title =~ s@[- :]*$@@s; $title = $stream_title . ($title ? ": $title." : ""); } else { ######################################################################## # # /audio/PERMANENT_NAME.EXT # ######################################################################## ( $idx, $hour, $min, $sec, $ext ) = ($ENV{PATH_INFO} =~ m@^/(.*?) # NAME (?: - (\d\d?) [-:]? (\d\d) [-:]? (\d\d) # HH:MM:SS )? (?: \. ([a-z\d]+) # .EXT )? $ @xi); error ("unparsable archive URL", "400 Bad Request") unless $idx; $start_secs = (($hour * 60 * 60) + ($min * 60) + $sec) if defined($hour); $ext = 'mp3' if (!defined ($ext) || ($ext =~ m/^(m3u|pls|txt|asx|xspf)$/si)); @files = ("$perma_dir/$idx.$ext"); } } else { ########################################################################## # # /mixtape/NNN.EXT # ########################################################################## my ( $idx, $hour, $min, $sec, $ext ) = ($ENV{PATH_INFO} =~ m@^/(.*?) # NAME (?: - (\d\d?) [-:]? (\d\d) [-:]? (\d\d) # HH:MM:SS )? (?: \. ([a-z\d]+) # .EXT )? $ @xi); error ("unparsable mixtape URL", "400 Bad Request") unless $idx; $start_secs = (($hour * 60 * 60) + ($min * 60) + $sec) if defined($hour); $ext = 'mp3' if (!defined ($ext) || ($ext =~ m/^(m3u|pls|asx|xspf)$/si)); my $dir = "$mixtape_dir/$idx"; $title = "$mixtape_title $idx"; my $md = "$dir/metadata.txt"; if ($ext =~ m@^(txt)$@si && -f $md) { @files = ( $md ); } else { opendir (my $dirh, "$dir") || error ("$idx unreadable", "500 Internal Error"); foreach my $f (sort readdir ($dirh)) { next if ($f =~ m/^\./s); next unless ($f =~ m/\.mp3$/si); push @files, "$dir/$f"; } closedir $dirh; } } error ("unparsable URL", "400 Bad Request") unless (@files); ############################################################################ # # Now handle the common parts: size, kbps, start seconds, titles. # ############################################################################ my $kbps = undef; my $date = undef; my $size = 0; foreach my $file (@files) { my @st = stat($file); $date = $st[9]; error ("URL does not exist", "404 Not Found") unless defined($date); $size += $st[7]; # We must assume that all files in the mixtape have the same bitrate. $kbps = file_kbps ($file) unless $kbps; } error ("Empty", "410 Gone") unless ($size > 50); if (! $title) { # If no metadata, use filename $title = $files[0]; $title =~ s@^\Q$perma_dir/@@gs; $title =~ s@^\Q$archive_dir/@@gs; $title =~ s@^/.*/@@gs; $title =~ s@\.[^/.]+$@@s; $title =~ s@[-._]@_@gs; my $dd = strftime ("%d-%b-%Y", localtime($date)); $stream_title = 'Flight Risk Radio' # Kludge if ($title =~ s@^flightriskradio/@@s); $title = "$stream_title: $dd: $title"; } my $bytes_per_second = $kbps * 125; # 128 = 16000 my $start_byte = $start_secs * $bytes_per_second; if ($start_byte > 0 && $start_byte + $bytes_per_second >= $size) { my $len = int($size / $bytes_per_second); error (sprintf ("can't start at %d:%02d:%02d -- " . "file is only %d:%02d:%02d long.", ($start_secs / (60 * 60)), ($start_secs / 60) % 60, ($start_secs % 60), ($len / (60 * 60)), ($len / 60) % 60, ($len % 60)), "400 Bad Request"); } $title .= sprintf(" (+%d:%02d:%02d)", ($start_secs / (60 * 60)), ($start_secs / 60) % 60, ($start_secs % 60)) if ($start_secs); return (\@files, $start_byte, $size, $date, $title, $kbps); } # Parse the URL and stream out the appropriate data. # sub stream_file() { my ($files, $start_byte, $end_byte, $date, $title, $kbps) = path_info_to_files(); # traitor.jwz.org log into /var/log/httpd/cerebrum/error_log if (($ENV{REMOTE_ADDR} || '') eq '70.36.236.109') { print STDERR "#########\n" . `printenv | sort` . "\n\n"; $verbose++; } my @files = @$files; my $file0 = $files[0]; my $permanent_p = ($file0 =~ m/^\Q$perma_dir/o); my $mixtape_p = ($file0 =~ m/^\Q$mixtape_dir/o); my ($ext) = ($ENV{PATH_INFO} =~ m@\.([a-z\d]+)$@si); my $ct = undef; my $body = undef; if (!defined ($ext) || $ext =~ m@^(mp3)@si) { # Audio $ct = "audio/mpeg"; } elsif ($ext =~ m/^(gif|pbm|png|p?jpe?g)$/si) { # Histogram images $ext =~ s/^pj?pe?g$/jpeg/si; $ct = "image/" . lc($ext); $permanent_p = 1; # Don't slowcat the images. open (my $in, '<:raw', $files[0]) || error ("$!", "404 Not Found"); local $/ = undef; # read entire file $body = <$in>; close $in; } elsif ($ext =~ m/^(txt)$/si) { # Metadata $ct = 'text/plain; charset=UTF-8'; $body = "$title\n" unless ($file0 =~ m@\.txt$@si); $permanent_p = 1; } elsif ($ext =~ m@^(pls|m3u|asx|xspf)$@si) { # Playlist files my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME}; error ("HTTP_HOST and SERVER_NAME are not set", "500 Internal Error") unless $host; 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 = ($ENV{HTTPS} ? "https://" : "http://") . $host . $ENV{REQUEST_URI}; $url =~ s@\.[a-z\d]+$@@gs; # remove M3U extension # 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'; # Put in a port if none was present. It turns out that some mp3 # players (Audion) require a port number. # $url =~ s@^(https?://[^:/]+)/@$1:80/@; my $secs = int (($end_byte - $start_byte) * 8 / ($kbps * 1024)); if ($ext =~ m@^m3u$@si) { $ct = "audio/mpegurl"; $body = ("#EXTM3U\n" . "#EXTINF:$secs,$title\n" . "$url\n"); } elsif ($ext =~ m@^pls$@si) { $ct = "audio/x-scpls"; $body = ("[playlist]\n" . "NumberOfEntries=1\n" . "Title1=$title\n" . "Length1=$secs\n" . "File1=$url\n"); } elsif ($ext =~ m@^xspf$@si) { $ct = "application/xspf+xml"; $body = ("\n" . " \n" . " $archive_url\n" . " " . strftime ("%Y-%m-%dT%H:%M:%S%z", localtime($date)) . "\n" . " \n" . " \n" . " " . html_quote($title) . "\n" . " " . ($secs * 1000) . "\n" . " $url\n" . " \n" . " \n" . " \n" . "\n"); } elsif ($ext =~ m@^asx$@si) { $ct = "video/x-ms-asf"; $body = ("\n" . " \n" . " " . html_quote($title) . "\n" . " \n" . " \n" . "\n"); } else { error ("unknown URL extension", "500 Internal Error") } $permanent_p = 1; } else { error ("unknown URL extension", "400 Bad Request"); } my $length = ($body ? length ($body) : $end_byte - $start_byte); my $cl = $length; if ($debug_p) { $ct = 'text/plain'; $cl = undef; } my $headers = ("Content-Type: $ct\r\n" . "Last-Modified: " . strftime ("%a, %d %b %Y %T GMT", gmtime($date)) . "\r\n"); ############################################################################ # # Parse the "Range:" header. # ############################################################################ my $range_start = undef; my $range_end = undef; { 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-EOF. # 1- is the same as 1-EOF. # $range_start = $1 || 0; # treat invalid "-N" as "0-N". $range_end = $2; $range_end = $length-1 if ($range_end eq '' || $range_end >= $length); } else { error ("unparsable Range header: $http_range", "400 Bad Request"); } } } my $random_p = (defined($cl) && ($permanent_p || $allow_random_access || defined($body))); 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. # error ("random-access not permitted (Range: $ENV{HTTP_RANGE})", "403 Forbidden (random access not permitted)") if ($range_start); # 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; } ############################################################################ # # Handle Icecast metadata # ############################################################################ # 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. # my $metaint = 0; if ($ct =~ m@^audio/@si) { 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 } # 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 @titles = (@files > 1 ? @files : ( $title )); foreach my $t (@titles) { my $t2 = $t; $t2 =~ s@^.*/@@; $t2 = "$title: $t2"; my $mdl = length($t2) + 12; $mdl = int (($mdl + 16) / 16) * 16; $length += $mdl; } $length += int ($length / $metaint); # plus one NUL every second } $headers .= "icy-metaint: $metaint\r\n" if ($metaint); } # Add icecast stream-info headers if this is an MP3. # if ($ct =~ m@^audio/@si) { $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; } ############################################################################ # # Stream the file # ############################################################################ # Need this or jPlayer can't get the metadata text. $headers .= "Access-Control-Allow-Origin: *\r\n" if ($ct =~ m@^text/@si); $headers .= "Content-Length: $cl\r\n" if (defined ($cl)); $headers .= "\r\n"; print STDOUT $headers; if ($verbose) { my $h2 = $headers; $h2 =~ s/\r\n/\n/gs; $h2 =~ s/\n+$//s; $h2 =~ s/^/==> /gm; print STDERR "$h2\n\n"; } $headers = undef; if (defined($cl) && $cl == 0) { # request for null data. return; } elsif ($body) { # Playlist or metadata: small file. $body = substr ($body, $range_start, ($range_end - $range_start + 1)) if (defined ($range_start)); print STDOUT $body; } else { # Streaming audio. # # Overlay this process with the "slowcat" program. # #my $burst_secs = 5; # 80 KB at 128 Kbps my $burst_secs = 30; # 480 KB at 128 Kbps # Apparently Safari always buffers 5 MB+ if Content-Length is present. # So feed it 6 MB (0:06:24 at 128 KBps) instead of the shorter default. # my $ua = $ENV{HTTP_USER_AGENT} || ''; if ($ua =~ m@\bSafari/@s && $ua !~ m@\b(Chrome|OPR)/@s) { my $mb = 6; $mb += 4 if ($ua =~ m@Mobile/@s); # It seems iPhone wants more? $burst_secs = ($mb * 1024) / ($kbps / 8); } if ($ua eq 'archive.org_bot') { $kbps = 1024 * 8 * 10; # MB/s $burst_secs = 0; } my @args = ( "--burst", $burst_secs, "--bps", $kbps . "k", "--range", $start_byte, $end_byte + 1, ); push @args, "--id3" unless $metaint; push @args, ("--icy", $metaint) if $metaint; # I tried sending an ID3 "TIT2" tag before each file, but that doesn't # work: iTunes 10 only listens to the very first one. # push @args, ("--title", $title) unless $metaint; if (@files == 1) { push @args, @files; } else { foreach my $f (@files) { my $t2 = $f; $t2 =~ s@^.*/@@s; $t2 =~ s@\.[^.]+$@@s; $t2 = "$title: $t2"; push @args, ("--title", $t2) if ($metaint); push @args, $f; } } unshift @args, "--verbose" if ($verbose); print STDERR "$progname: exec: $slowcat " . join(' ', @args) . "\n" if ($verbose); if ($debug_p) { print STDOUT join(' ', ($slowcat, @args)), "\n"; exit(0); } exec { $slowcat } ($slowcat, @args ); die "$progname: exec $slowcat failed: $?\n"; } } sub usage() { print STDERR "usage: $progname [--verbose]\n"; exit 1; } sub main() { $|=1; my $args = ''; # Only parse argv if we're not running as a CGI. # if (!defined ($ENV{REQUEST_URI})) { while ($_ = $ARGV[0]) { shift @ARGV; if (m/^--?verbose$/) { $verbose++; } elsif (m/^-v+$/) { $verbose += length($_)-1; } elsif (m/^-./) { usage; } elsif (m/^--?debug$/) { $debug_p++; } else { $args .= '&' if $args; $args .= $_; } } } if ($ENV{REQUEST_METHOD} && $ENV{REQUEST_METHOD} eq "POST") { $args .= '&' if $args; local $/ = undef; # read entire file $args .= ; error ("bad request method", "400 Bad Request"); } elsif ($ENV{QUERY_STRING}) { $args .= '&' if $args; $args .= $ENV{QUERY_STRING}; } foreach my $pair (split (/&/, $args)) { my ($key, $val) = ($pair =~ m/^([^=]+)=(.*)$/s); ($key, $val) = ($pair, 1) unless defined($key); if ($key eq 'debug') { $debug_p++ if ($val); } else { error ("URL unparsable: $pair", "400 Bad Request"); } } # 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. # error ("no path.", "400 Bad Request") if (!defined($ENV{PATH_INFO}) || $ENV{PATH_INFO} eq "" || $ENV{PATH_INFO} eq "/"); stream_file(); } main(); exit 0;