#!/usr/bin/perl -w
# audiofs --- simulates a file system, generating m3u and .mp3 files as needed.
# Copyright © 2001-2017 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/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.133 $' =~ 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 = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" .
               " <playlist version=\"1\" xmlns=\"http://xspf.org/ns/0/\">\n" .
               "  <info>$archive_url</info>\n" .
               "  <date>" .
                    strftime ("%Y-%m-%dT%H:%M:%S%z", localtime($date)) .
                 "</date>\n" .
               "  <trackList>\n" .
               "   <track>\n" .
               "    <title>" . html_quote($title) . "</title>\n" .
               "    <duration>" . ($secs * 1000) . "</duration>\n" .
               "    <location>$url</location>\n" .
               "   </track>\n" .
               "  </trackList>\n" .
               " </playlist>\n" .
               "</xml>\n");

    } elsif ($ext =~ m@^asx$@si) {
      $ct = "video/x-ms-asf";
      $body = ("<asx version=\"3.0\">\n" .
               " <entry>\n" .
               "  <title>" . html_quote($title) . "</title>\n" .
               "  <ref href=\"$url\" />\n" .
               " </entry>\n" .
               "</asx>\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 @args = ( "--burst", 5,
                 "--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 .= <STDIN>;
    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;