#!/usr/bin/perl -w # -*- cperl -*- #
#
#  gnump3d2 - A compatible Perl implementation of the original GNUMP3d.
#
#  GNU MP3D - A portable(ish) MP3 server.
#
# Homepage:
#   http://www.gnump3d.org/
#
# Author:
#  Steve Kemp <steve@steve.org.uk>
#
# Version:
#  $Id: gnump3d2,v 2.134 2003/07/02 20:39:15 stevekemp Exp $
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
#
#  Steve Kemp
#  ---
#  http://www.steve.org.uk/
#
#


#
#  Make sure that signals cause our END segment to run
# so that we are able to log even incomplete transfers.
#
use sigtrap qw(die normal-signals error-signals);

#
#  Packages and modules we use.
#
use strict;                # Standard safety checks.
use English;               # Avoid $<, etc.
use Getopt::Long;          # For our argument parsing.
use IO::Socket;            # Socketing code.
use Env;                   # Only necessary to read $HOME.
use POSIX ":sys_wait_h";   # For reaping children.
use gnump3d::base64;       # For decoding passwords.
use gnump3d::config;       # My configuration file reading module.
use gnump3d::files; 	   # My routines for working with files and dirs.
use gnump3d::FreezeThaw qw(freeze thaw);  # For persisting info
use gnump3d::playlist;     # My playlist generating code.
use gnump3d::tagcache;     # Access to the tag cache.
use gnump3d::IP;           # Local copy of NetAddr::IP.
use gnump3d::url;          # URL encoding and decoding

#
# Global variables
#
use vars qw ($main_socket %mime_cache );



#
#
#  Globally important settings.
#
#
#  These are settings which are read from the configuration file, or
# set by the command line.
#
#  If '--test' is specified upon the command line then environmental
# variables may be used to override the contents of the configuration
# file.
#
#
my $ROOT;             # The root of the MP3 archive.
my $PORT;             # The port the server listens upon.
my $bind_address;     # The address to bind upon.
my $host;             # The hostname of the local machine.
my $theme_dir;        # The directory from which theme files are read.
my $plugin_dir;       # The directory from which plugin files are read.
my $always_stream;    # Should songs be streamed always.
my $access_log;       # The file to write access logs to.
my $error_log;        # The file to write error logs to.
my $truncate_logs;    # Should logfiles be truncated.
my $client_host;      # Use the client supplied 'host:' header?
my $default_theme;    # The name of the default theme.
my $TIMEOUT;          # Timeout for socket reads - in seconds.
my $STATSPROG;        # Path to the statistics gather binary.
my $STATSARGS;        # Additional arguments to pass to the stats program.
my $INDEXPROG;        # Path to the gnump3d-index script
my $play_rec;         # Text to use for the 'play recursively' link.
my $mime_file;        # Location of the 'mime.types' file to read.
my $enable_browse;    # Enable people to browse the archive.
my $sort_order  ;     # Default sorting order.
my $down_enabled;     # Is downsampling enabled.
my $default_quality;  # Default quality for visitors.
my $dir_format ;      # Display format string for directories.
my $file_format;      # Display format string for files.
my $song_format;      # Display format string for song titles.
my $hide_song_tags;   # Should we just disable song tags?
my $NOW_PLAYING_FILE; # Cache file for the 'currently' playing tracks.
my $jukebox;          # Should we play songs locally?
my $jukebox_binary;   # The binary to use for playing locally.
my $tag_cache;        # The file to cache tag information to.

#
# Read-only variables.
#
my $REVISION      = '$Id: gnump3d2,v 2.134 2003/07/02 20:39:15 stevekemp Exp $';
my $VERSION       = "";
$VERSION = join (' ', (split (' ', $REVISION))[1..3]);
$VERSION =~ s/,v\b//;
$VERSION =~ s/(\S+)$/($1)/;

my $RELEASE = "2.5b";



#
#  We want to avoid SIG_PIPE signals.
#
#
$SIG{PIPE} = 'IGNORE';

#
#  Reap children - taken from the Perl Cookbook (Recipe 16.19)
#
$SIG{CHLD} = \&REAPER;
sub REAPER {
  my $stiff;
  while( ($stiff = waitpid(-1,&WNOHANG)) > 0 ) {
    # Do something with $stiff if you want
  }
  $SIG{CHLD} = \&REAPER;
}



#
#  Per-child globals.
#
#  The HTTP code is set here when the header is sent out in response to
# a client request.
#
#  The served size is incremented when data is sent out.
#
#  Both are used to write a log entry.
#
my $HTTP_CODE         = 0;   # The HTTP header code we sent to the client.
my $SERVED_SIZE       = 0;   # Size of data we've sent back to this client.
my $USE_SHOUTCAST     = 0;   # Should we serve Shoutcast information?
my $connected_address = "";  # The remote address of the connected client.
my $REQUEST           = "";  # The URI requested.
my $USER_AGENT        = "";  # If sent by the browser.
my $RANGE             = "";  # If a range header for seeking is sent.
my $AUTHORIZATION     = "";  # Only needed if '.password' protection is used.
my $LOGGED_IN_USER    = "";  # Only set if a valid user has logged in.
my $REFERRER          = "";  # The referrer which brought the client here.
my %ARGUMENTS         = ();  # URL parameters/cookie values.
my $data              ;      # The socket we communicate to our clients with.
my %NOW_PLAYING       = ();

#
#  These variables are set by the argument processing,
# and are used to control how we start up.
#
my $SHOW_HELP         = 0;  # Show help and exit.
my $SHOW_VERSION      = 0;  # Show version and exit.
my $CMD_ROOT          = ""; # Servers root directory.
my $CMD_PORT          = ""; # Servers port number.
my $CMD_THEME_DIR     = ""; # Theme directory.
my $CMD_PLUGIN_DIR    = ""; # Plugin loading directory.
my $CMD_DEFAULT_THEME = ""; # The default theme.
my $SHOW_PLUGINS      = 0;  # Show available plugins and exit.
my $BACKGROUND        = 0;  # Run in background.  Implies '$QUIET'
my $FAST_START        = 0;  # Start serving immediately; dont index the archive
my $QUIET             = 0;  # If set suppress the startup banner.
my $DEBUG             = 0;  # If report errors to the console
my $ENVIRONMENT       = 0;  # Allow environmental variables to override config
my $CONFIG_FILE       = ""; # Our configuration file.


#
# Parse any arguments which might be present upon the command line.
#
&parseArguments();


#
#  Read the configuration options from our configuration file.
#
&readConfigFile();


#
#  If any of the command line options were intend to override the
# configuration files contents then perform those overrides here.
#
&overideConfigFile();


#
#  Now check that all of our options are appropriate/sane.
#
#  This is done after reading the configuration file, and allowing
# the command line flags to take effect.
#
#  The intention is that these checks will catch common errors which
# will stop the server from running properly, or starting at all.
#
&sanityCheck();


#
# Parse the systems mime file - this is used to send appropriate
# Content-type: headers to clients.
#
&mkcache();


#
#  Empty the currently playing list
#
if ( defined( $NOW_PLAYING_FILE ) && ( -e $NOW_PLAYING_FILE ) )
{
    unlink( $NOW_PLAYING_FILE );
}

#
#  Create the socket for accepting connections upon.
#
$main_socket = new IO::Socket::INET (LocalAddr => $bind_address,
				     LocalPort => $PORT,
				     Listen    => 5,
				     Proto     => 'tcp',
				     ReuseAddr => 1,
				     Reuse => 1
				    );

#
# Shut down the listening socket upon interruptions.
#
$SIG{INT} = sub { close ($main_socket); print "Killed: SIG_INT\n"; exit; };


#
#  Check for success.
#
if ( ! defined( $main_socket ) )
{
    print " Couldn't create the listening socket for receiving incoming\n";
    print "requests upon.\n";
    print "\n";
    print " Perhaps the port $PORT is already in use?\n";
    print "\n";
    print " This is the error message the system returned:\n\t$!\n";
    exit;
}

#
#  Setup the buffering/flushing.
#
$main_socket->autoflush(1);



#
# Make sure our host is defined.
#
$host .= ":$PORT";


#
#  Print a little banner.
#
if ( ! $QUIET )
{
print <<EOB;
GNUMP3d v$RELEASE by Steve Kemp
http://www.gnump3d.org/

GNUMP3d is free software, covered by the GNU General Public License,
and you are welcome to change it and/or distribute copies of it under
certain conditions.

For full details please visit the COPYING URL given below:

  Copying details:
    http://$host/COPYING

  GNUMP3d now serving upon:
    http://$host/

  GNUMP3d website:
    http://www.gnump3d.org/
EOB

    if ( $jukebox )
    {
       if ( &isWindows() ) 
       {
          print "Jukebox mode will never be supported for Windows.\n";
	  $jukebox = 0;
       }
       else
       {
          print "Warning: This server is running with the untested, unfinished,\n";
          print "         jukebox mode enabled.\n";
       }
    }

    if ( $FAST_START )
    {
       print "\nFast Start Enabled - Your archive will not be indexed.\n" ;
    }
    else
    {
	print "\n Indexing your music collection, this may take some time.\n";
	print "(Run with '--fast' if you do not wish to do this to occur at startup).\n";
	#
	#  fork() + exec() - run `gnump3d-index` in the background.
	#
	#  This means that the song database is always up to date when the server starts.
	my $pid = 0;

	if ($pid = fork)
	{
	    # parent catches INT and berates user
	    local $SIG{INT} = sub { print "Tsk tsk, no process interruptus\n" };
	    waitpid($pid, 0);
	}
	else
	{
	    die "cannot fork: $!" unless defined $pid;
	    # child ignores INT and does its thing
	    $SIG{INT} = "IGNORE";
	    exec( $INDEXPROG ) or die "Can't exec '$INDEXPROG' : $!\n";
	}
	print " Indexing complete.\n";
    }
}



#
#  Fork into the background if we're supposed to.
#
#  NOTE: This won't happen if we're running under '--debug'.
#
if ( ( not $DEBUG ) and ( $BACKGROUND ) )
{
    fork() && exit;
}


#
#  Make sure that all our errors and output go to the error
# log if it's defined.
#
if ( ( defined( $error_log ) and length( $error_log ) ) )
{
    select STDOUT;
    $| = 1;

    if ( not $DEBUG )
    {
	if ( $truncate_logs )
	{
	    open (STDOUT,">$error_log");
	    open (STDERR,">$error_log");
	}
	else
	{
	    open (STDOUT,">>$error_log");
	    open (STDERR,">>$error_log");
	}
    }
}

#
#  Truncate the logfile if we've been told to.
#
if ( $truncate_logs )
{
    open ( LOGFILE,">$access_log") 
    	or warn "Unable to truncate the access log file : $access_log - $!";
    close( LOGFILE );
}

#
# Open the output logfile before we drop priviledges, or change user.
#
# NOTE: This is left open, but only flock()d where it is used.
#
open( LOGGER, ">>$access_log" )
  or die "Cannot open logfile: '$access_log' $!";



#
#  If there's a user we should run as we'll change to that now that
# we have bound our sockets, and opened our logfile(s).
#
my $username = getConfig( "user", "" );
if ( ( defined( $username ) ) and
     ( ! isWindows() ) )
{
    my ($n,$p, $u,$g, $q,$c,$gc,$dir,$sh);
    ($n,$p, $u,$g, $q,$c,$gc,$dir,$sh)=getpwnam( $username );

    if ( defined( $u ) and defined( $g ) )
    {
	print "I switching to user: $n (id:$u group id:$g)\n";

	$UID = $u;
	$EUID= $u;
	$GID = $g;
	$EGID= $g;
    }
    else
    {
	print "Error failed to find ID and GID for user $username\n";
	print "this means I can't switch user - so I'm not going to start!\n";
	exit;
    }

    #
    # Sanity check.
    #
    ($n,$p, $u,$g, $q,$c,$gc,$dir,$sh)=getpwuid( $< );
    print "I am now: $n (id:$u group id:$g)\n";
}


#
#  Main accept loop.
#
#  Listen for each incoming request, fork() a child to handle it.
#
#
while (1)
{
    $data = $main_socket->accept(); #wait for connections
    my $pid = fork();		    #we are forking...

    if ( $pid == 0 )
    {
	##
	# CHILD.
	##

	die "Could not fork! suicide...\n"
	    unless defined($pid);

	#
	# Timeout.
	#
	$SIG{ALRM} = sub { die "timeout" };

	if ($data)
	{
	    #
	    # Get the name of the connecting client.
	    #
	    my $other_end         = getpeername($data)
	      or warn "Couldn't identify other end: $!\n";
	    my ($port, $iaddr)    = unpack_sockaddr_in($other_end);
	    $connected_address    = inet_ntoa($iaddr);

	    my $i       = "";
	    my $request = "";

	    #
	    #  This eval block is here so that were can prevent DOS
	    # attacks by closing sockets if there's nothing received.
	    # after a while.
	    #
	    eval
	    {
		# Time is specified in config file.
		if ( ! &isWindows() )
		{
	         	alarm( $TIMEOUT );
		}

		#
		# Read in each line of the request - and save it for
		# later processing.
		#
		while ((defined($i = <$data>) && (length( $i ) > 2 )))
		{
		    $request .= "$i";
		}

		#
		# We've finished reading the header now - so cancel the
		# alarm timer.
		#
		if ( ! &isWindows() )
		{
			alarm(0);
		}
	    };

	    #
	    #  Test for timout errors.
	    #
	    if ($@)
	    {
		if ($@ =~ /timeout/)
		{
		    # Timed out.  Close socket.  Exit.
		    close($data);
		    exit;
		}
		else
		{
		    alarm(0);   # clear the still-pending alarm
		    die;        # propagate unexpected exception
		}
	    }

	    #
	    #  Make sure an URI was requested.
	    #
	    my $uri = undef;
	    if ( $request =~ /GET (.*) HTTP\// )
	    {
		$uri = $1;
	    }

	    #
	    # No URI -> HTTP Error
	    #
	    if ( !defined( $uri ) )
	    {
		my $header = &getHTTPHeader( 501, "text/html" );
		&sendData( $data, $header );
		close( $data );
		exit;
	    }

	    #
	    #  See if the client sent us a server name; if it did we use that
	    # in preference to what we were using - to handle ssh port
	    # forwarding etc.
	    #
	    #  This is a configurable option, controlled via the .conf file:
	    # 'use_client_host=0' to disable it.
	    #
	    if ( $client_host )
	    {
		if ( $request =~ /Host: ([^\r\n]+)/ )
		{
		    my $chost = $1;
		    if ( $chost =~ /(.*):([0-9]+)/ )
		    {
			# Host already contains a port.
			$host = $chost;
		    }
		    else
		    {
			# Host was missing a port number.
			$host = $chost . ":" . $PORT;
		    }
		}
	    }

	    #
	    # Copy the user-agent, if present, away for later logging.
	    #
	    if ( $request =~ /User-Agent: ([^\r\n]+)/ )
	    {
		$USER_AGENT = $1;
	    }
	    else
	    {
		$USER_AGENT = "Unknown";
	    }

	    #
	    # See if the client wanted to receive shoutcast meta-data.
	    #
	    if ( $request =~ /Icy-MetaData:/i )
	    {
		$USE_SHOUTCAST = 1;
	    }

	    #
	    # See if the client is sending a range header to indicate that
	    # we should skip some song info.
	    if ( $request =~ /Range: ([^\r\n]+)/ )
	    {
	        $RANGE = $1;
		if ( $RANGE =~ /bytes=(.*)-/ )
		{
		    $RANGE = $1;
		}
	    }

	    #
	    # Store away any authorization token we've been given.
	    # (This is only used if password protection of the archive
	    #  is enabled and used).
	    #
	    if ( $request =~ /Authorization: Basic ([^\r\n]+)/ )
	    {
		$AUTHORIZATION = $1;
	    }

            #
	    # Save the referrer away, if present.
	    #
	    if ( $request =~ /Referrer: ([^\r\n]+)/ )
	    {
	    	$REFERRER = $1;
	    }

	    #
	    #  Store any cookies into our request arguments hash.
            #
	    #  This is done so that we don't have to worry about
	    # any individual cookies.
	    #
	    if ( $request =~ /Cookie: ([^\r\n]+)/ )
	    {
		my $list = $1;

		my @cooks = split( /;/, $list );
		foreach my $cookie ( @cooks )
		{
		    if ( $cookie =~ /([^=]+)=(.*)/ )
		    {
			my $key = $1;
			my $val = $2;

			# Strip leading and trailing whitespace.
			$key =~ s/^\s+//;
			$key =~ s/\s+$//;
			$val =~ s/^\s+//;
			$val =~ s/\s+$//;

			if ( $key =~ /^theme$/i )
			{
				# Themes may only be named using numbers + letters
				$val =~ tr[A-Za-z0-9]||cd;
			}

			$val = &sanitizePath( $val );

			$ARGUMENTS{ $key } = &urlDecode( $val );
		    }
		}
	    }


	    #
	    #  Make sure the user is actually allowed to talk to us
	    # this works by comparing the client address to those addresses
	    # given in 'allowed_clients', and 'denied_clients'.
	    #
	    if ( &bannedAddress( $connected_address ) )
	    {
		my $header   = &getHTTPHeader( 200, "text/html" );
		&sendData( $data, $header );

		my $text = &getErrorPage( $ARGUMENTS{'theme'},
					  "Access has been denied to $connected_address" );
		&sendData( $data, $text );
		close( $data );
		exit;
	    }

	    #
	    #  See if the server admin has defined a particular
	    # referring URL which is allowed to connect.
	    #
            my $ref = &getConfig( "valid_referrer", undef );
	    if ( defined( $ref ) && length( $ref ) )
	    {
	    	# We can only test the referrer if one was supplied.
	    	if ( length( $REFERRER ) )
		{
		    if ( $REFERRER =~ /^$ref/ )
		    {
		    	print "Referrer '$REFERRER' matches '$ref'\n";
		    }
		    else
		    {
		    	my $header   = &getHTTPHeader( 200, "text/html" );
		        &sendData( $data, $header );

		        my $text = &getErrorPage( $ARGUMENTS{'theme'},
				  "Access has been denied to $connected_address" );
		        &sendData( $data, $text );
		        close( $data );
		        exit;
		    }
		}
	    }

	    #
	    # Don't allow traversal outside the root directory.
	    #
	    $uri = &sanitizePath( $uri );


	    #
	    # Handle an URL parameters which might be present.
	    #
	    if ( $uri =~ /(.*)\?(.*)/ )
	    {
		# Strip off the params from the URI
		$uri = $1;

		# Handle each parameter.
		my $args = $2;
		foreach my $term (split(/&/, $args ) )
		{
		    if ( $term =~ /([^=]+)=(.*)/ )
		    {
			my $key = $1;
			my $val = $2;
			$key = &urlDecode( $key );
			$val = &urlDecode( $val );

			if ( $key =~ /^theme$/i )
			{
				# Themes may only be named using numbers + letters
				$val =~ tr[A-Za-z0-9]||cd;
			}

			$val = &sanitizePath( $val );

			$ARGUMENTS{ $key } = $val;
		    }
		}
	    }

	    #
	    # Decode the URL encoding.
	    #
	    $uri = &urlDecode( $uri );

	    #
	    # Setup the default theme if one wasn't present in the request.
	    #
	    if ( !defined ( $ARGUMENTS{ "theme" } ) or
		 !length( $ARGUMENTS{ "theme" } ) )
	    {
		$ARGUMENTS{ "theme" } = $default_theme;
	    }


	    #
	    # Save the requested URL in a global, so we can log it
	    # when the transaction is over.
	    #
	    $REQUEST = $uri;

	    #
	    # Do not allow the serving of '.password' files.
	    #
	    if ( $uri =~ /.password$/i )
	    {
		my $header   = &getHTTPHeader( 404, "text/html" );
		&sendData( $data, $header );


		#
		# Prevent XSS attacks
		#
		$uri = urlEncode( $uri );

		my $text = &getErrorPage( $ARGUMENTS{'theme'},
					  "File not found : $uri" );
		&sendData( $data, $text );
		close( $data );
		exit;
	    }


	    #
	    # Test for a 'standard' playlist file.
	    #
	    if ( ( $uri =~ /random.m3u$/ ) or
		 ( $uri =~ /recurse.m3u$/ ) )
	    {
	        # Test that the user is allowed to do the recursive
	        # playlist.
	        my $pass = &getConfig( "enable_password_protection", 1 );
	        if ( $pass )
		{
		    &testDirectoryAccess( "/", $data );
		}

		#
		# If this is in the jukebox mode patch up.
		#
		if ( $jukebox )
		{
		    my $header   = &getHTTPHeader( 401, "text/html" );
		    &sendData( $data, $header );

		    my $text = &getErrorPage( $ARGUMENTS{'theme'}, 
					      "Jukebox mode only works for single files.  Sorry." );
		    &sendData( $data, $text );
		    close( $data );
		    exit;
		}

		my $playlist = &getPlaylist( $uri );
		my $header   = &getHTTPHeader( 200, "audio/x-mpegurl" );
		&sendData( $data, $header );
		&sendData( $data, $playlist );
		close( $data );
		exit;
	    }

	    #
	    # Test for a single file playlist file.
	    #
	    if ( ( $uri =~ /(.*)\.m3u$/ ) &&
		 ( $always_stream ) )
	    {
		my $plainFile = $1;
		my $testPath = $ROOT . "/" . $plainFile;
		$testPath = sanitizePath($testPath);
		if ( -e $testPath )
		{
		    #
		    #  This was just a single file playlist.
		    #
		    my $header   = &getHTTPHeader( 200, "audio/x-mpegurl" );
		    &sendData( $data, $header );

		    my $link = "http://" . $host . &urlEncode( $plainFile );

		    #
		    # Get ready to add on any bitrate settings to the file
		    # within the playlist.
		    #
		    if ( defined( $ARGUMENTS{"quality"} ) and
			 length(  $ARGUMENTS{"quality"} ) )
		    {
			$link .= "?quality=" . $ARGUMENTS{"quality"};
		    }

		    &sendData( $data, $link );
		    close( $data );
		    exit;
		}
	    }

	    #
	    # Mogrify the filename to a local file/directory.
	    #
	    #  TODO: Support virtual hosts here, amongst other places.
	    #        (This would be the key location though).
	    #
	    my $testPath = $ROOT . "/" . $uri;
	    $testPath = sanitizePath($testPath);

	    #
	    # Store the request in the currently playing file.
	    #
	    if ( ( &isAudio( $testPath ) ) &&
		 ( ! &isWindows( ) ) )
	    {
		# Read existing.
		if ( defined( $NOW_PLAYING_FILE ) && ( -e $NOW_PLAYING_FILE ) )
		{
		    my $contents = &readFile( $NOW_PLAYING_FILE );

	    	    eval
		    {
			%NOW_PLAYING = thaw( $contents );
		    };
		    if ( $@ )
		    {
			print "Error restoring currently playing database.\n";
			#%NOW_PLAYING = { };
		    }
		}

		# update
		$NOW_PLAYING{ $connected_address } = $testPath;

		# Store new list
		my $playing = freeze( %NOW_PLAYING );
		open( OUTPUT, ">$NOW_PLAYING_FILE" );
		flock( OUTPUT, 8 );
		print OUTPUT $playing;
		flock( OUTPUT, 8 );
		close( OUTPUT );
	    }

	    #
	    #  Now test to see if the request can be handled
	    # by a plugin.
	    #
	    if ( $uri =~ /\/([^?\/]+)/ )
	    {
		my $plugin = $1;
		$plugin = $plugin_dir . "/" . $plugin . ".pm";

		if ( -e $plugin )
		{
		    #
		    #  Make sure the user is authorized to view this
		    # plugin.
		    #
		    #  Don't do this if password protection is disabled.
		    #
		    my $pass = &getConfig( "enable_password_protection", 1 );
		    if ( $pass )
 		    {
		        &testDirectoryAccess( "/", $data );
		    }

		    #
		    # Only call the plugin if it hasn't been disabled.
		    #
		    my $disabled =  &getConfig( "plugin_" . $plugin,  "enabled" );
		    if ( $disabled ne "disabled" )
		    {
			&callPlugin( $plugin );
			exit;
		    }
		}
	    }


	    #
	    #  Test to see if the request was a directory.
	    #
	    if ( ( -d $testPath ) and $enable_browse )
	    {
		#
		#  Make sure the user is authorized to view this
		# directory - by using using .password file protection.
		#
		#  Don't do this if password protection is disabled.
		#
		my $pass = &getConfig( "enable_password_protection", 1 );
		if ( $pass )
		{
		    &testDirectoryAccess( $uri, $data );
		}

		my $header   = &getHTTPHeader( 200, "text/html" );
		&sendData( $data, $header );

		if ( $testPath =~ /(.*)\/$/ )
		{
		  # Nop
		}
		else
		{
		  $testPath .= "/";
		}

		my $directoryData = &serveDirectory( $testPath,
						     $ARGUMENTS{"theme"} );
		&sendData( $data, $directoryData );
		close( $data );
		exit;
	    }

	    #
	    #  Is this a plain file within the archive?
	    #
	    #  This could be; An album cover, a song itself, a movie,
	    # or a playlist.
	    #
	    if ( -f $testPath )
	    {
		if ( $testPath =~ /m3u$/i )
		{
		    #
		    # If this is in the jukebox mode patch up.
		    #
		    if ( $jukebox )
		    {
			my $header   = &getHTTPHeader( 401, "text/html" );
			&sendData( $data, $header );

			my $text = &getErrorPage( $ARGUMENTS{'theme'}, 
						  "Jukebox mode only works for single files.  Sorry." );
			&sendData( $data, $text );
			close( $data );
			exit;
		    }


		    #
		    # Get the possibly fixed up, playlist file
		    #
 		    my $text = &adjustPreMadePlaylist(  $testPath );

		    if ( length( $text ) )
		    {

		        my $header   = &getHTTPHeader( 200, 
						       "audio/x-mpegurl" );
			&sendData( $data, $header );
			&sendData( $data, $text );
			exit;
		    }
		    else
		    {
		        #
		        # There was a problem reading the playlist.
		        #
		        my $header   = &getHTTPHeader( 404, "text/html" );
			&sendData( $data, $header );


			my $text = &getErrorPage( $ARGUMENTS{'theme'},
						  "The selected playlist file is empty." );

			&sendData( $data, $text );
			exit;
		    }
		}
		else
		{
		    if ( &isAudio( $testPath ) )
		    {
			if ( $jukebox )
		        {
			    #
			    # Play song upon server...
			    #
			    &jukeBoxPlayFile( $testPath );

			    #
			    # Note: Above function never returns..
			    #
			}
			else
			{
			    #
			    # Serve an audio file, pos. with downsampling.
			    #
			    &streamAudioFile( $data, $testPath );
			}
		    }
		    else
		    {
			#
			# Serve a normal non-audio file.
			#
			&serveFile( $data, $testPath );
		    }
		}
		exit;
	    }

	    #
	    # Fall back to serving from the theme directory.
	    #
	    if ( defined( $ARGUMENTS{"theme"} ) &&
		 length $ARGUMENTS{"theme"} )
	    {
		$testPath =  $theme_dir . "/" . $ARGUMENTS{"theme"} . $uri;
		if ( -e $testPath )
		{
		    &serveFile( $data, $testPath );
		    exit;
		}
	    }

	    {
		#
		#  If we've not served the file by now we've hit an
		# error.
		#
		my $header   = &getHTTPHeader( 404, "text/html" );
		&sendData( $data, $header );

		#
		# Prevent XSS attacks
		#
		$uri = urlEncode( $uri );

		my $text = &getErrorPage( $ARGUMENTS{'theme'},
					  "File not found : $uri" );
		&sendData( $data, $text );
		close( $data );
		exit;
	    }

	    #
	    # We're finished with the socket now.
	    #
	    close($data);
	}

	#
	# Parent from the fork();
	#
	exit;
    }

    #nothing to do.. wait for next request
    close $data if $data;
}



#
#  Return the textual representation for the given HTTP response code,
# and MIME type.
#
sub getHTTPHeader( $ $ $ )
{
    my ( $code, $mime, $filename ) = (@_);

    my $header = "";

    #
    # Send appropriate Data to any shoutcast compatible clients.
    #
    if ( $USE_SHOUTCAST )
    {
	#
	# The title of the stream is the file information,
	# if a filename was given to us to use.
	#
	my $display = "GNUMP3d Stream";
	if ( defined( $filename ) and ( -e $filename ) )
	{
	    $display = &getSongDisplay( $filename, $song_format );
	}


	$header  = "ICY $code OK\r\n";
	$header .= "icy-notice1:This stream is served using GNUMP3d\r\n";
	$header .= "icy-genre:Mixed\r\n";
	$header .= "icy-name:$display\r\n";
	$header .= "icy-url:$host\r\n";
	$header .= "icy-pub:1\r\n";
    }
    else
    {
	$header = "HTTP/1.0 $code OK\r\n";
    }


    #
    # Cheap hack
    #
    if ( $mime eq "text/html" )
    {
	$mime = "text/html; charset=utf-8";
    }

    $header   .= "Connection: close\r\n";
    $header   .= "Server: $RELEASE\r\n"; # Identify ourself.
    $header   .= "Content-type: $mime\r\n";

    #
    # If we're going to serve a file send the last modified
    # date + size.
    #
    if ( defined( $filename ) and
	 ( -e $filename ) )
    {
	my ($a,$b,$c,$d,$e,$f,$g,$length,$h,$mtime) = stat($filename);
	$mtime = gmtime $mtime;
	my ($day, $mon, $dm, $tm, $yr) =
	    ($mtime =~ m/(...) (...) (..) (..:..:..) (....)/);

	$header .= "Content-length: $length\n";
	$header .= "Last-Modified: $day, $dm $mon $yr $tm GMT\n";
    }


    #
    # Set a cookie for each value we have received - even if they're
    # not used.
    #
    foreach my $key (sort (keys( %ARGUMENTS ) ) )
    {
      if ( defined( $ARGUMENTS{$key} ) )
      {
	my $val = $ARGUMENTS{ $key };
	$header .= "Set-Cookie: " . $key . "=" . $val . ";path=/\r\n";
      }
    }

    # Authorization required.
    if ( $code eq "401" )
    {
	$header .= "WWW-Authenticate: Basic realm=\"GNUMP3d\"\r\n";
    }

    #
    # Terminate the HTTP header.
    #
    $header   .= "Connection: close\r\n";
    $header   .= "\r\n";

    #
    #  Save the HTTP Header away - this will be written to the logfile
    # when the transaction is over.
    #
    $HTTP_CODE = $code;

    return( $header );
}


#
#  Return an error page of HTML to describe the given error.
#
sub getErrorPage( $ $ )
{
    my ( $theme, $text ) = (@_);

    my @lines = &getThemeFile( $theme, "error.html" );
    my $total = "";

    #
    # Process the template file.
    #
    foreach my $line ( @lines )
    {
	#
	# Make global substitutions.
	#
	$line =~ s/\$HOSTNAME/$host/g;
	$line =~ s/\$VERSION/$RELEASE/g;
	$line =~ s/\$DIRECTORY/\//g;
	$line =~ s/\$TITLE/$text/g;
	$line =~ s/\$ERROR_MESSAGE/$text/g;

	if ( $line =~ /(.*)\$BANNER(.*)/ )
	{
	    # Insert banner;
	    my $pre  = $1;
	    my $post = $2;
	    $total .= $pre;
	    $total .= &getBanner( "/" );
	    $total .= $post;
	}
	else
	{
	    $total .= $line;
	}
    }
    return( $total );
}


#
#  Return a fully formed playlist for the given directory.
#
sub getPlaylist( $ )
{
    my ($uri) = (@_);

    my $recurse = 0;
    my $random  = 0;
    my $dir     = 0;
    my $bitrate = "";

    if ( $uri =~ /(.*)\/all\.m3u$/ )
    {
	$dir     = $1;
	$random  = 0;
	$recurse = 0;
    }
    if ( $uri =~ /(.*)\/random\.m3u$/ )
    {
	$dir     = $1;
	$random  = 1;
	$recurse = 1;
    }
    if ( $uri =~ /(.*)\/recurse\.m3u$/ )
    {
	$dir     = $1;
	$recurse = 1;

	#
	# Default to not randomizing the recursive playlist, unless
	# the server config tells us to..
	#
	$random  = &getConfig( "recursive_randomize", 0 );
    }

    my $playlist = "";

    if ( length( $dir ) )
    {
	$playlist = playlistForDirectory( $ROOT . $dir, $recurse, $random );
    }
    else
    {
	$playlist = playlistForDirectory( $ROOT, $recurse, $random );
    }


    #
    # Get ready to add on any bitrate settings to the file
    # within the playlist.
    #
    if ( defined( $ARGUMENTS{"quality"} ) and
	 length(  $ARGUMENTS{"quality"} ) )
    {
	$bitrate = "?quality=" . $ARGUMENTS{"quality"};
    }

    my $final = "";
    my @list  = split( /\n/, $playlist );
    foreach my $entry (@list)
    {
	if ($entry =~ /$ROOT(.*)/)
	{
	    $entry = $1;
	}

	if ( ! $recurse  )
	{
	    $entry = $dir . "/" . $entry;
	}

	$entry = sanitizePath($entry);

	$entry = "http://" . $host . urlEncode( $entry ) . $bitrate;

	$final .= $entry . "\n";
    }
    return( $final );
}




#
#  Read and return a pre-existing playlist file from the repository.
#
#  This may have to patch up the contents intelligently.
#
sub adjustPreMadePlaylist( $ )
{
    my ( $playlist ) = ( @_ );

    my $dir      = $playlist;
    my $text     = "";


    if ( $dir =~ /$ROOT(.*)/ )
    {
	$dir = $1;
    }
    if ( $dir =~ /(.*)\/(.*)/ )
    {
	$dir = $1;
    }

    my @lines = &readFile( $playlist );
    foreach my $line ( @lines )
    {
        chomp( $line );

	if ( $line =~ /^\#/ )
	{
	    # Line is a comment.
	    # Leave it as is.
	}
	elsif ( $line =~ /$host/ )
	{
	    # Line already contains a server:port section.
	    # Leave it as is.
	}
	elsif ( $line =~ /$ROOT\/(.*)/ )
	{
	    #
	    # Line is fully qualified path.
	    #
	    $line = "http://" . $host . $1;
	}
	elsif ( $line =~ /^\// )
	{
	    #
	    # Line is fully qualified.  Just prepend the
	    # server name to it.
	    #
	    $line = "http://" . $host . $line;
	}
	else
	{
	    #
	    # Line is just a straight filename, it needs
	    # server:port + directory prepended to it.
	    $line = "http://" . $host . $dir . "/" . $line ;
	}

	#
	# Add the potentially modified line
	#
	$text .= $line . "\n";
    }

    return( $text );
}


#
#  Play the given file upon the local machine.
#
sub jukeBoxPlayFile( $ )
{
    my ( $file ) = ( @_ );

    my $safeFile = $file;
    $safeFile    =~ s/"/\"/g;
    $safeFile    = '"' . $file . '"';

    # Send OK header.
    my $header   = &getHTTPHeader( 200, "text/html" );
    &sendData( $data, $header );

    my $text = &getErrorPage( $ARGUMENTS{'theme'},
			      "Playing file '$file' locally!" );
    &sendData( $data, $text );
    close( $data );

    #
    # Evil. Hack.
    # TODO: Fixme.
    #
    system( $jukebox_binary, $safeFile );

    exit;
}

#
#  Stream an audio file to the waiting client.
#
#  NOTE: Here we test for downsampling.
#
sub streamAudioFile( $ $ )
{
    my ( $data, $file ) = (@_);

    #
    # Just serve the file if downsampling isn't enabled at the
    # server level.
    #
    if ( $down_enabled eq 0 )
    {
	print "Downsampling disabled for : $file\n";
	&serveFile( $data, $file );
	exit;
    }

    #
    # Get the quality requested.
    #
    my $quality = $ARGUMENTS{"quality"};


    #
    # If the user hasn't chosen a level default to the admin-provided
    # default if present.
    #
    if ( ( not defined( $quality ) ) ||
	 ( $quality eq "" ) )
    {
	$quality = $default_quality;

	if ( length( $default_quality ) )
	{
	    print "Downsampling quality set to '$default_quality' per config\n";
	}
	else
	{
	    print "Downsample disabled, users quality level is unset, and no default quality.\n";
	}
    }

    #
    # No supplied, or default, quality setup.
    # Serve the file normally.
    #
    if ( ( not defined( $quality ) ) ||
	 ( $quality eq "" ) )
    {
	&serveFile( $data, $file );
	exit;
    }

    #
    #  Here we have downsampling of some level enabled, but we don't know
    # what it is yet.
    #
    #
    my $suffix = &getSuffix( $file );
    my $configKey = "downsample_" . $quality . "_" . $suffix;

    my $cmd = &getConfig( $configKey, "" );
    if ( not( length( $cmd ) ) )
    {
	print "Downsample disabled we didnt find a command for filetype '$configKey'\n";
	serveFile( $data, $file );
	exit;
    }


    #
    # Expand the filename in the command line, taking care of
    # any tricky quoting conditions.
    #
    my $safeFile = $file;
    $safeFile    =~ s/"/\"/g;
    $safeFile    = '"' . $file . '"';

    #
    # Insert the safely quoted filename into the command we run.
    #
    $cmd =~ s/\$FILENAME/$safeFile/g;

    print "Downsampling - running: '$cmd' for '$file' at level '$quality'\n";

    #
    #  Serve HTTP header for the downsampled file.
    #
    my $mime = $mime_cache{ lc( &getSuffix( $file ) ) };
    if ( ! defined ( $mime ) )
    {
	print "No mime type found for $file\n";
	$mime = "text/html";
    }
    my $header   = &getHTTPHeader( 200, $mime, $file );
    &sendData( $data, $header);


    my $size = 0;
    my $buff = "";
    open( SAMPLE, "$cmd|" )
	or die "Cannot run : '$cmd $file' : $!";

    while ($size = read(SAMPLE, $buff, 2048) )
    {
        # check if the client closed the connection
        # if it did, kill downsampler to save cycles
        my $rin = '';
        my $rout;
        vec($rin,fileno($data),1) = 1;
        select($rout=$rin, undef, undef, 0);
        if(vec($rout,fileno($data),1)) {
	    $HTTP_CODE = 410;
            last;
        }

	print $data $buff;
	$SERVED_SIZE += $size;
    }
    close( SAMPLE );
    close( $data );
}


#
#  Serve a file, making correct use of the mime-type
#
sub serveFile( $ $ )
{
    my ($data, $path ) = (@_);

    my $mime = $mime_cache{ lc( &getSuffix( $path ) ) };
    if ( ! defined ( $mime ) )
    {
	warn "No mime type found for $path\n";
	$mime = "text/html";
    }

    my $header   = &getHTTPHeader( 200, $mime, $path );
    &sendData( $data, $header);

    open( FILE, "<" . $path ) or warn "Cant open '$path' : $!";
    binmode( FILE );

    my $size = 0;
    my $buff = "";


    # Seek if we're supposed to.
    if ( length( $RANGE ) && ( $RANGE > 0 ) )
    {
      print "SKIPPING $RANGE bytes\n";
      read(FILE, $buff, $RANGE);
      $buff = "";
    }

    #
    # Read in the file in 2k chunks, and serve it.
    #
    while ($size = read(FILE, $buff, 2048) )
    {
        # check if the client closed the connection
        # if it did, kill server to save cycles - log this
	# as HTTP code 410
        my $rin = '';
        my $rout;
        vec($rin,fileno($data),1) = 1;
        select($rout=$rin, undef, undef, 0);
        if(vec($rout,fileno($data),1)) {
	    $HTTP_CODE = 410;
            last;
        }

	print $data $buff;
	$SERVED_SIZE += $size;
    }
    close( FILE );
    close( $data );
}


#
# Parse the mime.types file into the global %mime_cache hash
#
# This code was taken from Pabache - a simple Perl HTTP server
#
#     http://freshmeat.net/projects/pabache/
#
sub mkcache ()
{
    my($type, $end, $i, $x);

    if (open(MM, "<$mime_file" ) )
    {
	while (defined($i = <MM>))
	{
	    while ($i =~ /\t\t/)
	    {
		$i =~ s/\t\t/\t/;
	    }
	    ($type, $end) = split(/\t/, $i);
	    if ($end)
	    {
		chomp($end);
	    }
	    if ($type)
	    {
		chomp($type); $type=~ tr/ //d;
	    }
	    if ($end)
	    {
		foreach $_ (split(/ /, $end))
		{
		    $mime_cache{$_} = $type;
		}
	    }
	}
	close(MM);
    }
    else
    {
	return 1;
    }
}


#
#  Send some data to the client.
#
#  This is here entirely so that we can keep track of the number of bytes
# transferred in our logfile.
#
sub sendData( $ $ )
{
    my ($socket, $tosend) = (@_);

    $SERVED_SIZE += length( $tosend );

    print $data $tosend;
}



#
#  Make up the GUI interface for a directory.
#
#  This code is suboptimal, but it's constrained fairly tightly by
# the pre-existing template format.
#
#
sub serveDirectory( $ $ )
{
    my ($dir, $theme) = (@_);

    my @lines = &getThemeFile( $theme, "index.html" );

    #
    # Look for per-theme configuration file.
    #
    if ( -e $theme_dir . "/" . $theme . "/" . "config.ini" )
    {
	&readConfig( $theme_dir . "/" . $theme . "/" . "config.ini" );

	#
	# Override defaults if there present.
	#
	$dir_format = &getConfig( "directory_format", $dir_format );
	$file_format= &getConfig( "file_format", $file_format );
	$song_format= &getConfig( "song_format", $song_format );
	$play_rec   = &getConfig( "play_recursively_text", $play_rec );
	$sort_order = &getConfig( "sort_order", $sort_order );
    }

    #
    # Allow per-connection sort order.
    #
    $sort_order = $ARGUMENTS{"sort_order" } || $sort_order;

    #
    # The path to the current directory as used in the links.
    #
    my $path = $dir;
    if ($path =~ /$ROOT(.*)/ )
    {
      $path = $1;
    }
    if ( $path =~ /(.*)\//)
    {
      $path = $1;
    }

    #
    # The total text we return
    #
    my $total = "";

    # Total up things we find.
    my $totalFiles     = 0;
    my $totalPlaylists = 0;
    my $totalSubdirs   = 0;
    my $totalMovies    = 0;

    my $directory = $path;
    if ( ! length( $directory ) )
    {
	$directory = "/";
    }

    #
    # Process the template file.
    #
    foreach my $line ( @lines )
    {
	#
	# Make global substitutions.
	#
	$line =~ s/\$HOSTNAME/$host/g;
	$line =~ s/\$VERSION/$RELEASE/g;
	$line =~ s/\$DIRECTORY/$directory/g;

	#
	# Now handle the special sections.
	#
	if ( $line =~ /(.*)\$BANNER(.*)/ )
	{
	    # Insert banner;
	    my $pre  = $1;
	    my $post = $2;

	    $total .= $pre;

	    $total .= &getBanner( $path );
	    $total .= $post;
	}
	elsif ( $line =~ /(.*)\$DIRECTORIES(.*)/ )
	{
	    #
	    # Insert subdirectories;
	    #
	    #  Make sure that we pay attention to the 'directory_format'
	    # setting.
	    #
	    my $pre  = $1;
	    my $post = $2;
	    $total .= $pre;

	    #
	    # Find all the subdirs.
	    #
	    my @files     = &dirsInDir( $dir );

	    foreach my $file (@files)
	    {
		# Increase count.
		$totalSubdirs += 1;

		#
		# Get ready to insert variables into the `directory_format`
		# template string.
		#
		my $link = "$path/$file/";
		$link    = &urlEncode( $link );

		my $name = $file;
		my $rec  = "<a href=\"$path/$file/recurse.m3u\">$play_rec</a>";

		my $row  = $dir_format;

		#
		# Only calculate the number of songs if necessary.
		# Optimization.
		#
		if ( $row =~ /\$SONG_COUNT/ )
		{
		    my @subfiles = &filesInDir( "$dir/$file" );

		    #
		    # Strip out things like .title files.
		    #
		    my @totalFiles = ();
		    foreach my $sf (@subfiles)
		    {
			my $valid = 0;
			if ( &isAudio( $sf ) ||
			     &isPlaylist( $sf ) ||
			     &isMovie( $sf ) )
			  {
			      $valid ++;
			  }
			if ( defined( $ARGUMENTS{"hideogg"} ) and
			     ( $ARGUMENTS{ "hideogg" } ) )
			  {
			      if ( $sf =~ /ogg$/i )
				{
				    $valid = 0;
				}
			  }
			if ( defined( $ARGUMENTS{"hidemp3"} ) and
			     ( $ARGUMENTS{ "hidemp3" } ) )
			  {
			      if ( $sf =~ /mp3$/i )
				{
				    $valid = 0;
				}
			  }
			if ( defined( $ARGUMENTS{"hidemov"} ) and
			     ( $ARGUMENTS{ "hidemov" } ) )
			  {
			      if ( &isMovie( $sf ) )
				{
				    $valid = 0;
				}
			  }

			if ( $valid > 0 )
			  {
			      push @totalFiles, $sf;
			  }
		    }

		    my $count = $#totalFiles + 1;
		    if ( $count == 1 )
		    {
			$count = "1 song";
		    }
		    elsif ($count > 0 )
		    {
			$count = "$count songs";
		    }
		    else
		    {
			$count = "";
		    }
		    $row =~ s/\$SONG_COUNT/$count/g;
		}
		if ( $row =~ /\$DIR_COUNT/ )
		{
		    my @subfiles = &dirsInDir( "$dir/$file" );

		    my $count = $#subfiles + 1;
		    if ($count == 1 )
		    {
			$count = "1 subdirectory";
		    }
		    elsif ( $count > 0 )
		    {
			$count = "$count subdirectories";
		    }
		    else
		    {
			$count = "";
		    }
		    $row =~ s/\$DIR_COUNT/$count/g;

		}

		#
		#  Do the interpolation.
		#
		$row =~ s/\$LINK/$link/g;
		$row =~ s/\$DIR_NAME/$name/g;
		$row =~ s/\$RECURSE/$rec/g;
		$row =~ s/\$LINK/$link/g;

		#
		# Add to the text we're building up.
		$total .= $row;
	    }

	    $total .= $post;
	}
	elsif ( $line =~ /(.*)\$SONGS(.*)/ )
	{
	    #
	    # Insert songs into the output text.
	    #
	    my $pre  = $1;
	    my $post = $2;
	    $total .= $pre;


	    #
	    # Read all the files.
	    #
	    my @files = &filesInDir( $dir );

	    #
	    # The files we are going to display.
	    #
	    my @DISPLAY = ( );

	    foreach my $file (@files)
	    {
		print "File ... $file\n";
		next if ( not  isAudio( $file ) );

		if ( defined( $ARGUMENTS{"hideogg" } ) and
		     ( $ARGUMENTS{"hideogg"} eq 1 ) )
		{
		    next if ( $file =~ /ogg$/i );
		}
		if ( defined( $ARGUMENTS{"hidemp3" } ) and
		     ( $ARGUMENTS{"hidemp3" } eq 1 ) )
		{
		    next if ( $file =~ /mp3$/i );
		}

		push @DISPLAY, $dir . "/" . $file;
		print "Kept $file\n";
	    }

	    $totalFiles = $#DISPLAY + 1;

	    my $tagCache = gnump3d::tagcache->new( );
	    $tagCache->setCacheFile( $tag_cache );
	    $tagCache->setFormatString( $song_format );
	    $tagCache->setHideTags( $hide_song_tags );

	    my %TAGS     = $tagCache->formatMultipleSongTags( @DISPLAY );

	    foreach my $key ( keys( %TAGS ) )
	    {
		# Get the display text
		my $display = $TAGS{ $key };

		# Strip the directory name from the key now that we
		# have found the tags.
		if ( $key =~ /(.*)\/(.*)/ )
	        {
		    $key = $2;
		}

		# Modify the link if necessary.
		my $suffix = "";
		if ( $always_stream )
		{
		    $suffix = ".m3u";
		}

		#
		# Build up the text to insert into the file lists.
		#
		my $link = $path . "/" . $key . $suffix;
		$link = &urlEncode( $link );

		my $plink= $path . "/" . $key;
		$plink = &urlEncode( $plink );

		#
		# Do the interpolation.
		my $output = $file_format;
		$output    =~ s/\$LINK/$link/g;
		$output    =~ s/\$PLAINLINK/$plink/g;
		$output    =~ s/\$SONG_FORMAT/$display/g;

		#
		# Add the song to the display.
		$total .= $output;
		$total .= "\n";

	    }
	    $total .= $post;
	}
	elsif ( $line =~ /(.*)\$PLAYLISTS(.*)/ )
	{
	    #
	    # Insert any playlists into the output text.
	    #
	    my $pre  = $1;
	    my $post = $2;
	    $total .= $pre;


	    #
	    # Read all the files.
	    #
	    my @files = &filesInDir( $dir );
	    foreach my $file (@files)
	    {
		next if ( not isPlaylist( $file ) );

		# Increase count.
		$totalPlaylists += 1;

		# Get the display text
		my $display = $file;
		if ( $file =~ /([^\.]+)\.(.*)/ )
		{
		    $display = $1;
		}

		#
		# Build up the text to insert into the file lists.
		#
		my $link = $path ."/" . $file;

		# URL Encode link to playlist.
		$link = &urlEncode( $file );

		#
		# Do the interpolation.
		my $output = $file_format;
		$output    =~ s/\$LINK/$link/g;
		$output    =~ s/\$SONG_FORMAT/$display/g;

		#
		# Add the playlist to the display.
		$total .= $output;
		$total .= "\n";

	    }
	    $total .= $post;
	}
	elsif ( $line =~ /(.*)\$MOVIES(.*)/ )
	{
	    #
	    # Insert movies into the output text.
	    #
	    my $pre  = $1;
	    my $post = $2;
	    $total .= $pre;


	    #
	    # Read all the files.
	    #
	    my @files = &filesInDir( $dir );
	    foreach my $file (@files)
	    {
		next if ( not isMovie( $file ) );

		if ( defined( $ARGUMENTS{"hidemov" } ) and
		     ( $ARGUMENTS{"hidemov" } eq 1 ) )
		{
		    next if isMovie( $file );
		}

		# Increase count.
		$totalMovies += 1;

		# Get the display to use for the movie, from any
		# .title file which might be present.
		my $display = &getSongDisplay( $dir . "/" . $file, "" );

		#
		# Build up the text to insert into the file lists.
		#
		my $link = $path ."/" . $file;

		# URL Encode link to movie
		$link = &urlEncode( $file );

		# Plain link
		my $plink= $path . "/" . $file;
		$plink = &urlEncode( $plink );

		#
		# Do the interpolation.
		my $output = $file_format;
		$output    =~ s/\$LINK/$link/g;
		$output    =~ s/\$PLAINLINK/$plink/g;
		$output    =~ s/\$SONG_FORMAT/$display/g;

		#
		# Add the song to the display.
		$total .= $output;
		$total .= "\n";

	    }

	    $total .= $post;
	}
	else
	{
	    $total .= $line ;
	}
    }

    #
    # Remove empty sections.
    #
    if ( $totalPlaylists eq 0 )
    {
	$total =~ s/<PLAYLISTS>.*<\/PLAYLISTS>//gsx;
    }
    if ( $totalFiles eq 0 )
    {
      $total =~ s/<FILES>.*<\/FILES>//gsx;
    }
    if ( $totalSubdirs eq 0 )
    {
      $total =~ s/<DIRS>.*<\/DIRS>//gsx;
    }
    if ( $totalMovies eq 0 )
    {
      $total =~ s/<MOVIES>.*<\/MOVIES>//gsx;
    }

    #
    # Return the directory contents as a formatted pretty HTML text file.
    #
    return ($total);
}


#
#  Format the song tags via the currently defined template string.
#
sub getSongDisplay( $ $ )
{
  my ( $file, $format ) = ( @_ );

  #
  # If we're hiding song tags just display the filename
  if ( $hide_song_tags )
  {
    if ( $file =~ /(.*)\/(.*)/ )
    {
    	$file = $2;
    }
    if ( $file =~ /(.*)\.(.*)/ )
    {
    	$file = $1;
    }
    return( $file );
  }
  else
  {
      my @ARRAY = ( );
      push @ARRAY, $file;

      my $tagCache = gnump3d::tagcache->new( );
      $tagCache->setCacheFile( $tag_cache );
      $tagCache->setFormatString( $format );
      $tagCache->setHideTags( $hide_song_tags );

      my %TAGS     = $tagCache->formatMultipleSongTags( @ARRAY );
      return( $TAGS{ $file } );
  }
  # NOT REACHED
}

#
#  Read a given .html file from the given theme directory.
#
#  If the theme directory doesn't exist return the file from
# the default directory.
#
#
#  (We also interpolate the standard variables).
#
#
sub getThemeFile( $ $ )
{
    my ( $theme, $file ) = (@_);

    my $themeFile = "";

    if ( defined( $theme ) && ( length( $theme ) ) )
    {
	$themeFile = $theme_dir . "/" . $theme . "/$file";
	if ( not -e $themeFile )
	{
	    $themeFile = $theme_dir . "/default/$file";
	}
    }
    else
    {
	$themeFile = $theme_dir . "/default/$file";
    }

    if ( not -e $themeFile )
    {
	print "The '$file' doesn't exist for the theme '$theme'\n";
	exit;
    }


    my @lines = &readFileWithExpansion( $themeFile );

    return( @lines );
}


#
#  Return a HTML banner for the given directory.
#
sub getBanner( $ )
{
    my ( $dir ) = (@_);
    my $prev = "";

    my $banner = "[ <a href=\"/\">Home</a>";

    my @list = splitPath( $host, $dir );

    foreach my $component ( @list )
    {
	if ( $component =~ /$host(.*)/ )
	{
	    my $path = $1;
	    if ( $path =~ /(.*)\/(.*)\/+/ )
	    {
		$path = $2;
	    }
	    if ( $path ne "/" )
	    {
		$banner .= " &middot; <a href='http://$component'>$path</a>";
	    }
	}
    }

    #
    # Interpolate links.
    #
    $banner .= " | <a href=\"recurse.m3u\">$play_rec</a> ]";

    return( $banner );
}



#
#  Test to see if the given IP address should be banned,
# or granted access to our server.
#
#  Tests 'allowed_clients' and 'denied_clients'.
#
#  NOTE: denied_clients overrides allowed_clients.
#
sub bannedAddress( $ )
{
    my ($client) = (@_);

    my $allow = &getConfig( "allowed_clients", "all" );
    my $deny  = &getConfig( "denied_clients", "none" );

    #
    # Multiple entries may be seperated by ';' characters.
    #
    my @good = split( /;/, $allow );
    my @bad  = split( /;/, $deny );

    my $allowed = 0;

    #
    #  Test each allowed pattern first.
    #
    foreach my $test ( @good )
    {
	if ( &matchIPAddress( $test, $client ) )
	{
	    $allowed = 1;
	}
    }

    #
    #  But then allow the 'denied' list to override any
    # allowed client.
    #
    foreach my $test ( @bad )
    {
	if ( &matchIPAddress( $test, $client ) )
	{
	    $allowed = 0;
	}
    }
    return ( not $allowed );
}


#
# Match an IP address against a pattern.
#
sub matchIPAddress( $ $ )
{
    my ($pattern, $address ) = ( @_ );

    # Strip leading and trailing whitespace.
    $pattern =~ s/^\s+//;
    $pattern =~ s/\s+$//;
    $address =~ s/^\s+//;
    $address =~ s/\s+$//;

    if ( $pattern eq "all" )
    {
	return 1;
    }
    if ( $pattern eq "none" )
    {
	return 0;
    }

    #
    # Split the address for wildcard matching.
    #
    my $ip = new gnump3d::IP $address;
    if ($ip->within(new gnump3d::IP $pattern, ))
    {
	return 1;
    }
    else
    {
	return 0;
    }
}


#
#  Test access to a given directory.
#
sub testDirectoryAccess( $ $)
{
    my ($directory,$data ) = (@_);

    $directory = $ROOT . "/" . $directory;

    print "Testing for directory: $directory\n";

    if ( -e  $directory . "/.password" )
    {
	#
	print "Password file found\n";
	if ( not length( $AUTHORIZATION ) )
	{
	    # Send auth required header.
	    my $header   = &getHTTPHeader( 401, "text/html" );
	    &sendData( $data, $header );

	    my $text = &getErrorPage( $ARGUMENTS{'theme'},
				      "Access has been denied to $connected_address" );
	    &sendData( $data, $text );
	    close( $data );
	}
	else
	{
	    my $decoder = gnump3d::base64->new( );
	    my $decoded = $decoder->decode( $AUTHORIZATION );
	    my $user = "";
	    my $pass = "";

	    if ( $decoded =~ /(.*):(.*)/ )
	    {
		$user = $1;
		$pass = $2;
	    }

	    if ( ( not length( $pass ) ) or
		 ( not length( $user ) ) )
	    {
		#
		# Null usernames/passwords are invalid.
		#
		my $header   = &getHTTPHeader( 401, "text/html" );
		&sendData( $data, $header );

		my $text = &getErrorPage( $ARGUMENTS{'theme'}, "Access has been denied to $connected_address" );
		&sendData( $data, $text );
		close( $data );
	    }

	    #
	    # Find a match.
	    #
	    open( PASSWORD, "<$directory/.password" ) or warn "Can't open: password file : $!";
	    my @valid = <PASSWORD>;
	    close( PASSWORD );
	    foreach my $line ( @valid )
	    {
		chomp($line);
		if ( $line eq "$user:$pass" )
		{
		    # Successful login - saved logged in username
		    $LOGGED_IN_USER = $user;

		    return;
		}
	    }

	    #
	    #  Record failed login attempts
	    #
	    print "Error : invalid login for user : $user\n";

	    #
	    # No match found
	    #
	    my $header   = &getHTTPHeader( 401, "text/html" );
	    &sendData( $data, $header );

	    my $text = &getErrorPage( $ARGUMENTS{'theme'}, "Access has been denied to $connected_address" );
	    &sendData( $data, $text );
	    close( $data );

	}
    }
    else
    {
	print "No password file found.\n";
    }
}


#
#  Break a Unix path into a list of parent entries.
#
sub splitPath( $ $ )
{
    my ( $prefix, $path ) = (@_);
    $path .= "/";

    my @list = "";
    while( $path =~ /(.*)\/(.*)/ )
    {
	$path = $1;
	push @list, $prefix . $path . "/";
    }

    return( reverse( @list ) );
}


#
#  Call one of our plugins.
#
sub callPlugin( $ )
{
    my ($plugin) = (@_);

    if ( -e $plugin )
    {
	print "Plugin '$plugin' exists.  Reading it.\n";

        open( PLUGIN, "<$plugin" ) or warn "can't read: $!";
	my @PLUGIN = <PLUGIN>;
	close( PLUGIN );

	#
	# Process the text from the plugin - the 'useless'
	# regular expression is to untaint the data, needed
	# if root starts the script.
	#
	my $text = "";
	foreach my $line ( @PLUGIN )
	{
	    if ( $line =~ /(.*)/ )
	    {
		$line = $1;
	    }
	    $text .= $line . "\n";
	}

	#
	# Import the plugins code into our namespace.
	#
	eval( $text );
	if ( $@ )
	{
	    print "Plugin load error $plugin : $@ ";
	}

        #
	# This function MUST be provided by plugin
	#
	&handlePath( $REQUEST );

	#
	# Allow the plugin to be re-called.
	#
	undef( &getAuthor );
	undef( &getVersion );
	undef( &handlePath );
    }
    else
    {
	print "Plugin '$plugin' not found\n";
    }
}


#
#  Show the name and version of a plugin.
#
sub dumpPlugin( $ )
{
    my ($plugin) = (@_);

    if ( -e $plugin )
    {
	open( PLUGIN, "<$plugin" ) or warn "can't read: $!";
	my @PLUGIN = <PLUGIN>;
	close( PLUGIN );

	#
	# Process the text from the plugin - the 'useless'
	# regular expression is to untaint the data, needed
	# if root starts the script.
	#
	my $text = "";
	foreach my $line ( @PLUGIN )
	{
	    if ( $line =~ /(.*)/ )
	    {
		$line = $1;
	    }
	    $text .= $line . "\n";
	}

	#
	# Import the plugins code into our namespace.
	#
	eval( $text );
	if ( $@ )
	{
	    print "Plugin load error $plugin : $@ ";
	}

        #
	# This function MUST be provided by plugin
	#
	my $author = &getAuthor( );
	my $version= &getVersion( );

	#
	# Display it.
	print "$version by $author\n";

	#
	# Allow the plugin to be re-called.
	#
	undef( &getAuthor );
	undef( &getVersion );
	undef( &handlePath );
    }
    else
    {
	print "Plugin '$plugin' not found\n";
    }
}





#
#  If any of the command line options were intend to overwride the
# configuration files contents then perform those overwrides here.
#
sub overideConfigFile()
{
  if ( length( $CMD_ROOT ) )
    {
      $ROOT = $CMD_ROOT;
    }
  if ( length( $CMD_PORT ) )
    {
      $PORT = $CMD_PORT;
    }
  if ( length( $CMD_THEME_DIR ) )
    {
      $theme_dir = $CMD_THEME_DIR;
    }
  if ( length( $CMD_PLUGIN_DIR ) )
    {
      $plugin_dir = $CMD_PLUGIN_DIR;
    }
  if ( length( $CMD_DEFAULT_THEME ) )
    {
      $default_theme = $CMD_DEFAULT_THEME;
    }
}

#
#  Parse our command line arguments, and set some of
# our global variables to indicate how the server should
# start up - or change important settings.
#
sub parseArguments( )
{

  #
  #  Setup the default configuration file which will be read
  # in the absence of command line flags.
  # users ~/.gnump3drc over the system wide one.
  #
  if ( ( $ENV{"HOME"} ) &&
       ( -e $ENV{"HOME"} . "/.gnump3drc" ) )
  {
      $CONFIG_FILE = $ENV{"HOME"} . "/.gnump3drc";
  }
  elsif ( -e "/etc/gnump3d/gnump3d.conf" )
  {
      $CONFIG_FILE = "/etc/gnump3d/gnump3d.conf";
  }
  elsif ( -e "gnump3d.conf" )
  {
      # This is mainly here for Windows users.
      $CONFIG_FILE = "gnump3d.conf";
  }


    GetOptions(
	       "background", \$BACKGROUND,
	       "config=s", \$CONFIG_FILE,
	       "debug", \$DEBUG,
	       "fast", \$FAST_START,
	       "help", \$SHOW_HELP,
	       "version", \$SHOW_VERSION,
	       "quiet", \$QUIET,
	       "plugin=s", \$CMD_PLUGIN_DIR,
	       "plugin-dir=s", \$CMD_PLUGIN_DIR,
	       "test", \$ENVIRONMENT,
	       "theme-dir=s", \$CMD_THEME_DIR,
	       "default-theme=s", \$default_theme,
	       "dump-plugins", \$SHOW_PLUGINS,
	       "port=s", \$CMD_PORT,
	       "root=s", \$CMD_ROOT,
	       );

    if ( $BACKGROUND )
    {
	# Running in the background implies running
	# quietly.
	$QUIET += 1;
    }
    if ( $SHOW_HELP )
    {
	print <<END_OF_HELP;
GNUMP3d v$RELEASE - A portable(ish) MP3/OGG/HTTP streaming server.
             - See http://www.gnump3d.org/ for more details.

Usage: gnump3d [options]

 --background            Detatch from the console after starting.
 --config filename       Read options from the named configuration file.
 --debug                 Dump debug output to the console, not the error log.
 --dump-plugins          Display all plugins that have been found.
 --fast                  Start quickly without indexing the audio files first.
 --help                  Display this usage information.
 --plugin-dir directory  Load the plugins from the given directory.
 --port number           Listen and serve upon the given port number.
 --quiet                 Do not display the startup banner.
 --root directory        Serve music from the given directory.
 --test                  Allow config variables to come from the environment.
 --theme-dir directory   Load the theme files from the given directory.
 --version               Displays the version of this software.

 Report bugs to : Steve Kemp <steve\@steve.org.uk>

END_OF_HELP
	exit;
    }
    if ( $SHOW_VERSION )
    {
	print "gnump3d v$RELEASE [CVS Info: $VERSION]\n";
	exit;
    }
    if ( $SHOW_PLUGINS )
    {
        # Read in the configuration file.
        &readConfigFile();

        #
        # ALlow the command line flags to override the configuration file.
        &overideConfigFile();

	#
	# Make sure that the plugin directory exists.
	#
	if ( not -d $plugin_dir )
	{
	    print "The plugin directory '$plugin_dir' doesn't exist.\n";
	    exit;
	}

	#
	# Get all the possible plugin files.
	#
	my @plugins = sort( glob( $plugin_dir . "/*.pm" ) );
	my $found   = 0;

	foreach my $plugin (@plugins)
	{
	    $found += 1;

	    #
	    # Display the plugin
	    #
	    &dumpPlugin( $plugin );

	}

	if ( $found eq 0 )
	{
	    print "No plugins found in directory '$plugin_dir'\n";
	}
	exit;
    }
}


#
#  Read the configuration variables from the specified configuration file.
#
#  If testing is enabled then allow the contents of environmental variables
# to override those specified in the file.
#
sub readConfigFile()
{
  if ( ! -e $CONFIG_FILE )
    {
      print "The configuration file which I've tried to raad doesn't exist:\n";
      print "'$CONFIG_FILE'\n";
      print "Aborting.\n";
      exit;
    }

  #
  # Initialize ourself from the configuration file.
  #
  &readConfig( $CONFIG_FILE );

  #
  # Possibley allow the environmental variables to override the configuration
  # file.
  &configUsesEnvironment( $ENVIRONMENT );

  #
  # Main settings.
  #
  $ROOT          = getConfig( "root", "/home/mp3" );
  $PORT          = getConfig( "port", 8888 );
  $bind_address  = getConfig( "binding_host", "" );
  $host          = getConfig( "hostname", "localhost" );
  $theme_dir     = getConfig( "theme_directory", "/usr/share/gnump3d" );
  $plugin_dir    = getConfig( "plugin_directory",  "/usr/lib/perl5/gnump3d/plugins" );
  $always_stream = getConfig( "always_stream", 1 );
  $access_log    = getConfig( "logfile", "/var/log/gnump3d/access.log" );
  $error_log     = getConfig( "errorlog", "/var/log/gnump3d/error.log" );
  $truncate_logs = getConfig( "truncate_log_file", 0 );
  $client_host   = getConfig( "use_client_host", 1 );
  $default_theme = getConfig( "theme", "default" );
  $TIMEOUT       = getConfig( "read_time", 10 );
  $STATSPROG     = getConfig( "stats_program", "/usr/bin/gnump3d-top" );
  $INDEXPROG     = getConfig( "index_program", "/usr/bin/gnump3d-index" );
  $STATSARGS     = getConfig( "stats_arguments", "" );
  $play_rec      = getConfig( "play_recursively_text",  "Play" );
  $mime_file     = getConfig( "mime_file",  "/etc/gnump3d/mime.types" );
  $enable_browse = getConfig( "enable_browsing", 1 );
  $sort_order    = getConfig( "sort_order", '$SONGNAME' );

  #
  #  Make sure 'root' is specified using '/' characters, not '\' under
  # windows.
  #
  $ROOT =~ s/\\/\//g;

  #
  #  For use by the '/now/' plugin.
  #
  $NOW_PLAYING_FILE = getConfig( "now_playing_file", '/tmp/now_playing.db' );

  #
  # Downsampling
  #
  $down_enabled    = getConfig( "downsample_enabled", 0 );
  $default_quality = getConfig( "default_quality", "" );

  #
  # Display formats.
  #
  $dir_format  = getConfig( "directory_format", "" )|| die "No directory_format" ;
  $file_format = getConfig( "file_format", "" )     || die "No file_format";
  $song_format = getConfig( "song_format", "" )     || die "No song_format";
  $hide_song_tags = getConfig( "hide_song_tags", 0 );

  # Tag cache
  $tag_cache   = getConfig( "tag_cache", "" );

  #
  # Experimental features.
  #
  $jukebox        = getConfig( "jukebox_mode", 0 );
  $jukebox_binary = getConfig( "jukebox_player", "/usr/bin/mpg123" );
  if ( $jukebox )
  {
     $always_stream = 0;
  }
}

#
#  Strip "/../" from paths.
#
sub sanitizePath
{
    my ($path) = shift;

    #
    #  Filter out "/../".  Repeatedly.
    #
    while ( $path =~ /(.*)[\\\/]\.\.[\\\/](.*)/ )
    {
        $path = $1 . $2;
    }
    while ( $path =~ /(.*)([\\\/][\\\/]+)(.*)/ )
    {
        $path = $1 . "/" . $3;
    }

    return( $path );
}


#
#  Make some simple checks that the settings are reasonable.
#
sub sanityCheck()
{
    #
    # Test for MP3 root directory.
    #
    if ( ! -x $ROOT ) {
      print "The server root you have specified doesn't exist: $ROOT\n";
      exit;
    }

    #
    # Test that the theme directory exists.
    #
    if ( ! -d $theme_dir ) {
      print "The theme directory you've chosen '$theme_dir' doesn't exist\n";
      exit;
    }


    #
    # Test that the plugin directory exists.
    #
    if ( ! -d $plugin_dir ) {
      print "The plugin directory you've chosen '$plugin_dir' doesn't exist\n";
      exit;
    }


    #
    # Make sure the default theme exists.
    #
    if ( ! -d $theme_dir . "/" . $default_theme ) {
      print "The theme directory '$theme_dir' doesn't contain the default theme '$default_theme'";
      print "you should specify a different one.\n";
      exit;
    }

    #
    # Make sure we'll be able to send the correct Content-type: header.
    #
    if ( ! -e  $mime_file ) {
      print "You don't appear to have the file '$mime_file' upon your system\n";
      exit;
    }

    #
    #  If the logfile isn't writable we'll not be able to log anything.
    #
    if ( ( -e $access_log ) && ( ! -w $access_log ) ) {
      print "The logfile you've chosen to use '$access_log' isn't writable by you!\n";
      exit;
    }

    # The logfile doesn't exist, can we create it?
    if ( $access_log =~ /(.*)\/(.*)/ )
    {
        my $dir = $1;
	
	if ( ! -d $dir )
	{
	    print "The directory '$dir' which should create our logfile '$access_log'\n";
	    print "doesn't exist.  Exitting.\n";
	    exit;
	}
	if ( ! -w $dir )
	{
	    print "The directory '$dir' within which should create our logfile isn't writable by you.";
	    print "Exitting.\n";
	    exit;
	}
    }
}



#
#  Return todays date and time; in a format suitable for
# logging to our access log.
#
sub http_date ()
{
    my( $nday, $nmon, $day, $time, $year);
    my $now = scalar(gmtime());
    $now =~ s/  / /g;
    ($nday, $nmon, $day, $time, $year) = split(/ /, $now);
    $day = sprintf("%02d", $day);
    return "$day\/$nmon\/$year:$time +0000";
}


#
#  This next block is special - it is called automagically by Perl when the
# current process is dying.
#
#  Here we take the opertunity to log the current request, if we have one
# setup (ie. if we're a child process).
#
#  We have to log at the point, because when the request is initiated we don't
# know what HTTP access code we're going to send, nor do we know the size of
# the transfer we're going to make.
#
#
#
END
{
    #
    #  The client isn't connected now - so remove the track from
    # the list of currently streaming songs.
    #
    if ( $REQUEST && $connected_address )
    {
	if ( defined( $NOW_PLAYING{ $connected_address } ) )
	{
	    # Read existing.
	    if ( defined( $NOW_PLAYING_FILE ) && ( -e $NOW_PLAYING_FILE ) )
	    {
		my $contents = &readFile( $NOW_PLAYING_FILE );

		eval
		{
		    %NOW_PLAYING = thaw( $contents );
		};
		if ( $@ )
		{
		    print "Error restoring currently playing database.\n";
		    #%NOW_PLAYING = { };
		}
	    }

	    if ( $NOW_PLAYING{$connected_address} )
	    {
		my $file = $ROOT . "/" . $REQUEST ;
		while( $file =~ /\/\// )
		{
		    $file =~ s/\/\//\//g;
		}
		if ( $NOW_PLAYING{$connected_address} =~ /$file/ )
		{
		    print "Found : $NOW_PLAYING{$connected_address}\n";
		    delete $NOW_PLAYING{$connected_address};

		    # Store new list
		    my $playing = freeze( %NOW_PLAYING );
		    open( OUTPUT, ">$NOW_PLAYING_FILE" );
		    flock( OUTPUT, 8 );
		    print OUTPUT $playing;
		    flock( OUTPUT, 8 );
		    close( OUTPUT );
		}
	    }
	    else
	    {
		print "Noting in $NOW_PLAYING_FILE for $connected_address\n";
	    }
	}
    }

    #
    #  Only log if we sent back a HTTP header code.
    #
    #  This should mean that we are only called when we're the child.
    #
    if ( $HTTP_CODE ne 0 )
    {
	#
	# Note the time/datestamp is that of the access _finishing_
	# not starting.
	#
	my $date  = http_date();

	#
	#  Lock the output logfile.
	#
	flock( LOGGER, 8 );

	#
	#  We have no logged in username.
	#
	my $user = "-";

	#
	#  Get the remote logged in username if one is present
	#
	if ( length( $LOGGED_IN_USER ) )
        {
	    $user = $LOGGED_IN_USER;
	}

	#
	# Mostly Apache combined log format compatible.
	#
	print LOGGER "$connected_address - $user [$date] \"GET $REQUEST\" $HTTP_CODE $SERVED_SIZE \"-\" \"$USER_AGENT\"\n";

	#
	# unlock and close logfile.
	flock( LOGGER, 8 );
	close( LOGGER );
    }

    #
    # Unlock and close the logfile.
}

