#!/usr/bin/perl -w # audiofs --- simulates a file system, generating m3u and .mp3 files as needed. # Copyright © 2001, 2002, 2003, 2004 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/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; my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.23 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; my $verbose = 0; my $file_bitrate = "128"; my $file_bytes_per_second = 16000; # the magic number for 128k mp3 files... my $allow_random_access = 1; my $max_listeners = 50; # only allow this many simultanious listeners $max_listeners = -1; ## MacOS has no "pidof"... 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:$file_bitrate", "x-audiocast-public: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 = '^209\.157\.133.'; sub error { my ($http_status, $err) = @_; if (defined($ENV{REQUEST_URI})) { print "Status: $http_status\n"; print "Content-Type: text/html\n"; print "\nError\n"; print "\n"; print "

$http_status

\n"; $err =~ s/&/&/g; $err =~ s//>/g; print "$err\n

\n"; if (0) { print "

\n"; foreach (sort keys(%ENV)) { $_ = "$_ = " . $ENV{$_}; s/&/&/g; s//>/g; print "$_ \n"; } print "

\n"; } exit (0); } else { print STDERR "$progname: $err\n"; exit 1; } } 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; } 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)$ # .EXT @xi; if (defined($year) && defined($ext)) { $file = "$data_dir/$year/$month-$day$idx.mp3"; @st = stat($file); } else { # maybe there's a perma-url? $file = undef; s@^/@@; my $filename = $_; ($filename, $ext) = m@^(.*?)\.(mp3|m3u|pls)$@; if ($ext) { 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_]+$@) { $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 ("400 Bad Request", "unparsable URL: $url") unless (defined ($file) && defined($ext)); my $secs = (($hour * 60 * 60) + ($min * 60) + $sec); my $start_byte = $secs * $file_bytes_per_second; my $size = $st[7]; error ("404 Not Found", "$url does not exist") unless defined($size); error ("410 Gone", "$url is empty") unless ($size > $file_bytes_per_second); if ($start_byte + $file_bytes_per_second >= $size) { my $len = int($size / $file_bytes_per_second); error ("400 Bad Request", 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))); } my @months = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); $month = $months[$month-1] if (defined ($month)); my $blurb = ""; { my $blurb_file = $file; if ($blurb_file =~ s@\.[^./]+$@.desc@) { local *IN; if (open (IN, "<$blurb_file")) { print STDERR "$progname: reading $blurb_file\n" if ($verbose > 1); while () { $blurb .= $_; } close IN; $blurb =~ s/^([^\s]+\.html)\n//si; # lose html file name on first line } else { $blurb = $blurb_file; $blurb =~ s@^.*/@@; $blurb =~ s@\.[^.]+$@@; $blurb =~ s@[-_]+@ @g; } } } $blurb =~ s/\n/ /gs; # newlines to whitespace $blurb =~ s@(.*?)
(.*?)@$1 $2@gs; # no newlines inside $blurb =~ s/<(BR|P)>/\n/igs; # html breaks to newlines $blurb =~ s/</]*>//g; # lose html tags $blurb =~ s/\s+/ /g; # compress whitespace $blurb = "$day-$month-$year: $blurb" if (defined ($year)); $blurb =~ s@[- :]*$@@s; my $title = "$stream_title: $blurb."; if ($secs) { $title .= sprintf(" (+%d:%02d:%02d)", $hour, $min, $sec); } return ($file, $start_byte, $size, $title); } sub stream_file { my ($file, $start_byte, $end_byte, $title) = path_info_to_file(); my $bitrate = $file_bitrate; my $range_start = undef; my $range_end = undef; my $permre = qr/$perm_dir/; my $permanent_p = ($file =~ m/^$permre/o); my $random_p = ($permanent_p || $allow_random_access); my $length = $end_byte - $start_byte; my $headers = ""; $headers .= "Content-Type: audio/mpeg\r\n"; { my $http_range = $ENV{HTTP_RANGE}; if ($http_range) { if ($http_range =~ m/^bytes=(\d*)-(\d*)$/) { $range_start = $1 || 0; $range_end = $2 || $length; if ($range_end > $length) { error ("416 Requested Range Not Satisfiable", "Range out of range: ($range_end > $length)"); } } else { error ("400 Bad Request", "unparsable Range header: $http_range"); } } } if ($random_p) { # The Content-Length header is always the length of the data actually sent. my $cl = ($range_start ? $range_end - $range_start : $length); $headers .= "Content-Length: $cl\r\n"; $headers .= "Accept-Ranges: bytes\r\n"; if ($range_start) { my $re = $range_end - 1; # 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 { # # If random access is not allowed, and a Range: header was specified in # the request, then return an error. # if ($range_start) { error ("403 Forbidden (random access not permitted)", "random-access not permitted (Range: $ENV{HTTP_RANGE})"); } # 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. # # $headers .= "Content-Length: $length\r\n"; $headers .= "Accept-Ranges: none\r\n"; } $headers .= "x-audiocast-name: $title\r\n"; # header name is case sensitive! $headers .= $extra_headers . "\r\n"; $headers .= "\r\n"; check_listener_count(); print STDOUT $headers; $headers = undef; if ($slowcat) { # # Overlay this process with the "slowcat" program. # exec { $slowcat } ($slowcat, $bitrate . "k", $start_byte, $file); die "$progname: exec $slowcat failed: $?\n"; } else { # # Cat the file out at full speed. # local *IN; open (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, 1024); print $buf; } while ($n > 0); close (IN); } } sub check_listener_count { # # If there are too many folks connected, error out. # 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 ("503 Too Many Listeners ($count): try again later!", "Too Many Listeners: try again later!"); } } sub generate_playlist { my ($file, $start_byte, $end_byte, $title) = path_info_to_file(); my $server = ($ENV{HTTP_HOST} ? $ENV{HTTP_HOST} : $ENV{SERVER_NAME}); error ("500 Internal Error", "HTTP_HOST and SERVER_NAME are not set") unless $server; error ("500 Internal Error", "REQUEST_URI is not set") unless $ENV{REQUEST_URI}; error ("500 Internal Error", "PATH_INFO is not set") unless $ENV{PATH_INFO}; my $url = "http://$server" . $ENV{REQUEST_URI}; if ($url =~ m/^(.*)\.(pls|m3u)$/i) { $url = "$1.mp3"; } else { error ("400 Bad Request", "URL does not end in PLS or M3U?"); } # 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 "\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 ("400 Bad Request", "no path."); } elsif ( $ENV{PATH_INFO} =~ m/\.(pls|m3u)$/i ) { generate_playlist(); } elsif ( $ENV{PATH_INFO} =~ m/\.mp3$/i ) { stream_file(); } else { error ("400 Bad Request", "bogus file extension: $ENV{PATH_INFO}"); } } main; exit 0;