#!/usr/bin/perl -w # mixtape --- simulates a file system, generating m3u and .mp3 files as needed. # Copyright © 2001-2007 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/mixtape/001.m3u # refers to the ".mp3" version of that URL. # # http://cerebrum.dnalounge.com:8001/mixtape/001.mp3 # refers to a directory of files at /home/archive/mixtapes/001/ # and streams them in order using "playlist-streamer.c". require 5; use diagnostics; use strict; my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.10 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; my $verbose = 0; my $debug_p = 0; my $file_bitrate = "128"; my $file_bytes_per_second = 16000; # the magic number for 128k mp3 files... my $max_listeners = 50; # only allow this many simultanious listeners $max_listeners = -1; ## MacOS has no "pidof"... my $stream_title = "jwz mixtape"; my @extra_headers = ("x-audiocast-admin: webmaster\@dnalounge.com", "x-audiocast-server-url: http://www.dnalounge.com/webcast/mixtapes/", "x-audiocast-url: http://www.dnalounge.com/webcast/mixtapes/", "x-audiocast-bitrate: $file_bitrate", "x-audiocast-public: 0"); my $data_dir = "/home/archive/mixtapes"; my $exec_dir = $data_dir; my $streamer = "$exec_dir/playlist-streamer"; # 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 stream_file() { my $metaint = 0; my $mixdir = $data_dir; my $subdir = $ENV{PATH_INFO}; $subdir =~ s/\.mp3$//si; $subdir =~ s@^/+@@si; # Only send metadata if the client says they can handle it. # Or if it's lying, lying iTunes. # if ((defined ($ENV{HTTP_ICY_METADATA}) && $ENV{HTTP_ICY_METADATA} ne '0') || (defined ($ENV{HTTP_USER_AGENT}) && $ENV{HTTP_USER_AGENT} =~ m@^iTunes/@)) { $metaint = $file_bytes_per_second; } my $title = "$stream_title $subdir"; error ("404 Not Found", "no such mixtape: \"$subdir\"") unless (-d "$mixdir/$subdir"); my @files = (); my $cl = 0; { local *DIR; opendir (DIR, "$mixdir/$subdir") || error ("500 Internal Error", "$subdir unreadable"); foreach (sort readdir (DIR)) { next if (m/^\./s); next unless (m/\.mp3$/s); my $f = "$mixdir/$subdir/$_"; push @files, $f; } closedir DIR; foreach my $f (@files) { my $size = (stat($f))[7] || -1; error ("500 Internal Error", "size = $size for \"$f\"") unless ($size > 16000); $cl += $size; # 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 $f2 = $f; $f2 =~ s@^.*/@@; my $mdl = length($f2) + 12; $mdl = int (($mdl + 16) / 16) * 16; $cl += $mdl; } } $cl += int ($cl / $metaint) # plus one NUL every second if ($metaint); } my $headers = ""; $headers .= (join ("\r\n", ("Content-Type: audio/mpeg", "Content-Length: $cl", "Accept-Ranges: none", "x-audiocast-name: $title", # header name is case sensitive! "icy-name: $title", ($metaint ? "icy-metaint: $metaint" : "Blat: foop"), @extra_headers)) . "\r\n" . "\r\n"); check_listener_count(); print STDOUT $headers; print STDERR "$progname: headers: " . length($headers) . " bytes\n" if ($verbose); # # Overlay this process with the "playlist-streamer" program. # my @args = ( $file_bitrate . "k", $metaint ); unshift @args, "-v" if ($verbose); unshift @args, "-d" if ($debug_p); print STDERR "$progname: exec: $streamer " . join(' ', @args) . " [..." . ($#files+1) . " files...]\n" if ($verbose); exec { $streamer } ($streamer, @args, @files ); die "$progname: exec $streamer failed: $?\n"; } 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($streamer) ? $streamer : $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 $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] [--debug mixtape-dir]\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/^--debug$/) { $debug_p = 1; my $t = shift @ARGV; usage unless $t; $t =~ s@/+$@@s; ($data_dir, $t) = ($t =~ m@^(.*)/([^/]+)$@s); $ENV{PATH_INFO} = "/$t.mp3"; $exec_dir = $data_dir; $streamer =~ s@^.*/@./@s; $ENV{HTTP_ICY_METADATA} = 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;