#!/usr/bin/env perl

# This code is provided without warranty of any kind.  If you break it, you
# get to keep the pieces.
#
# I ran it as /usr/local/www/apache24/cgi-bin/apachee24_ls.cgi, with the
# following lines somewhere in httpd.conf (without the "#", of course):
#
# <Directory "/usr/local/www/apache24/cgi-bin">
#     AllowOverride None
#     Options None
#     Require all granted
# </Directory>
#
# ScriptAlias /cgi-bin/ "/usr/local/www/apache24/cgi-bin/"
#
# DirectoryIndex index.cgi index.html /cgi-bin/apache24_ls.cgi
#
# [end of httpd.conf lines]
#
# This code has at least six limitations.  (Thanks, Monty Python!)
#
# 1. It has been tested only with an apache configuration that's wide open.  A
#    more security-conscious configuration may break this script.
# 2. It has not been designed with security configurations in mind.  You may
#    wish to improve it to make it more secure.
# 3. Even laying aside security considerations, it was written with common
#    configuration assumptions in mind.  I don't even know exactly what those
#    assumptions are, and you won't either until you actually run this script
#    in an environment where those assumptions don't hold.
# 4. It doesn't take into account strange characters like percent sign and
#    space.
# 5. You may wish to narrow the display by removing some of the displayed
#    information.
# 6. It logs debugging info to /tmp/billylog.  You may wish to make use of
#    this while debugging your own modifications, and/or remove this feature
#    entirely by searching for "billylog" in the script.
# 7. I'm sure it has bugs.
#
# Bill Evans
# wje@acm.org

use strict;
use warnings FATAL=>"all";

#-----------------------------------------------------------------------------

sub billylog
{
  my $out_string=shift;

  my $phyle;

  open($phyle,">>","/tmp/billylog");

  print($phyle sprintf("%05d",$$)."$out_string\n");

  close($phyle);

} # billylog()

#-----------------------------------------------------------------------------

sub spit
{
  my $spittle=shift;

  print $spittle;

  $spittle=~s/\r?\n?$//;

  billylog("\"$spittle\"")
}

#-----------------------------------------------------------------------------

sub fix_spaces
{
  my $in_string=shift;

  $in_string=~s/ /\&nbsp\;/g;

  return $in_string;

} # fix_spaces()

#-----------------------------------------------------------------------------

sub etc_passwd
{
  my $identity=shift;
  my $flags   =shift;

  my $in_line;
  my $phyle;

  my @array;

  open($phyle,"<","/etc/passwd")
  or
  return "<FONT COLOR=gray>inaccessible</FONT>";

  while($in_line=<$phyle>)
  {
    $in_line=~s/\r?\n?$//;

    if($in_line=~/^\#/)
    {
      next;   # <---------
    }

    @array=split(/:/,$in_line);

    if(0+$array[2] == $identity)
    {
      close($phyle);

      return sanitize($array[0]);
    }
  }

  close($phyle);

  if(defined($flags))
  {
    return "<FONT COLOR=gray>no such user name</FONT>";
  }
  else
  {
    return sanitize($identity);
  }

} # etc_passwd()

#-----------------------------------------------------------------------------

sub etc_group
{
  my $identity=shift;
  my $flags   =shift;

  my $in_line;
  my $phyle;

  my @array;

  open($phyle,"<","/etc/group")
  or
  return "<FONT COLOR=gray>inaccessible</FONT>";

  while($in_line=<$phyle>)
  {
    $in_line=~s/\r?\n?$//;

    if($in_line=~/^\#/)
    {
      next;   # <---------
    }

    @array=split(/:/,$in_line);

    if(0+$array[2] == $identity)
    {
      close($phyle);

      return sanitize($array[0]);
    }
  }

  close($phyle);

  if(defined($flags))
  {
    return "<FONT COLOR=gray>no such group name</FONT>";
  }
  else
  {
    return sanitize($identity);
  }

} # etc_group()

#-----------------------------------------------------------------------------

sub printable_time
{
  my $the_time=shift;

  my $sec;
  my $min;
  my $hour,
  my $mday,
  my $mon,
  my $year;

  my @mlist=("Jan",
             "Feb",
             "Mar",
             "Apr",
             "May",
             "Jun",
             "Jul",
             "Aug",
             "Sep",
             "Oct",
             "Nov",
             "Dec"
            );

  ($sec,
   $min,
   $hour,
   $mday,
   $mon,
   $year
  )=localtime($the_time);

  return sprintf("%04d&nbsp;%s&nbsp;%2d&nbsp;%02d:%02d:%02d",
                 $year+1900,
                 $mlist[$mon],
                 $mday,
                 $hour,
                 $min,
                 $sec
                );

} # printable_time()

#-----------------------------------------------------------------------------

sub sanitize
{
  my $in_string=shift;

  if(!defined($in_string))
  {
    $in_string="<FONT COLOR=gray>undefined</FONT>";
  }
  else
  {
    $in_string=~s/\&/\&amp\;/g;
    $in_string=~s/\</\&lt\;/g;
    $in_string=~s/\>/\&gt\;/g;

    if($in_string eq "")
    {
      return "&nbsp;";
    }
  }

  return $in_string;

} # sanitize()

#-----------------------------------------------------------------------------

sub handler
{
  my $home_directory;
  my $in_line;
  my $param_1dot;
  my $param_2dots;
  my $param_dir_1;
  my $param_dir_2;
  my $param_file_1;
  my $param_file_2;
  my $param_mode_switching;
  my $passwd_phyle;
  my $physical_filename;
  my $single_key;
  my $single_value;
  my $target_filename;
  my $test_mode;
  my $user_name;

  my @arg_array;
  my @passwd_fields;

  my %arg_hash;

  billylog("=== \"".$ENV{"REQUEST_URI"}."\"");

  $target_filename=$ENV{"REQUEST_URI"};
  $target_filename=~s/^(.*?)\?.*$/$1/;
  $target_filename=~s/\/+$//;
  $physical_filename=$target_filename;

  if($physical_filename=~/^\/\~/)
  {
    $user_name=$physical_filename;
    $user_name=~s/^\/\~(.*?)\/.*$/$1/
    or
    $user_name=~s/^\/\~([^\/]*)$/$1/;

    if(open($passwd_phyle,"<","/etc/passwd"))
    {
      while($in_line=<$passwd_phyle>)
      {
        $in_line=~s/\r?\n?$//;

        if($in_line=~/^\#/)
        {
          next;   # <---------
        }

        @passwd_fields=split(/\:/,$in_line);

        if(scalar(@passwd_fields)!=7)
        {
          next;   # <---------
        }

        if($passwd_fields[0] eq $user_name)
        {
          last;   # <---------
        }
      }

      close($passwd_phyle);
    }

    if(defined($in_line))
    {
      $physical_filename=~s/^\/\~(.*?)\//$passwd_fields[5]\/public_html\//;
      $physical_filename=~s/^\/\~(.*?)$/$passwd_fields[5]\/public_html/;
    }
  }

  if($ENV{"QUERY_STRING"})
  {
    @arg_array=split(/\&/,$ENV{'QUERY_STRING'});
  }

  while(scalar(@arg_array))
  {
    $single_key  =$arg_array[0];
    $single_value=$arg_array[0];

    if($single_key=~/\=/)
    {
      $single_key  =~s/^(.*?)\=(.*)$/$1/;
      $single_value=~s/^(.*?)\=(.*)$/$2/;
    }
    else
    {
      $single_value="";
    }

    $arg_hash{$single_key}=$single_value;

    shift(@arg_array);
  }

  if(defined($arg_hash{"test"}))
  {
    $test_mode=1;
  }
  else
  {
    $test_mode=0;
  }

  if($test_mode) { ###########################################################

  spit("Content-Type: text/html\n");
  spit("\n");
  spit("<HTML><BODY>\n");

  spit("<table border bgcolor=#FFFFC0>\r\n");

  spit("<thead><td><tt>variable name</tt></td><td><tt>value</tt></td></thead>\r\n");

  foreach $single_key (sort keys %ENV)
  {
    spit("<tr><td><tt>$single_key</tt></td><td><tt>\"".sanitize($ENV{$single_key})."\"</tt></td></tr>\r\n");
  }

  spit("</table>\r\n");

  spit("</BODY></HTML>\n");

  return 0;

  } # if(test_mode) ##########################################################

  # The f parameter informs us, when we're generating a directory, whether the
  # directory will end up in a single frame; the lefthand frame; the righthand
  # frame; the righthand frame of a framework which we should provide, and put
  # the directory's parent in the lefthand frame; or the lefthand frame of a
  # frameset which we should provide, and put the specified document in the
  # righthand frame.
  #
  # Parameters are handled as follows.
  #
  # -- If there are no parameters:
  #
  #    -- If the directory contains index.cgi or index.html, pump it out.
  #    -- Otherwise, divide the document into two frames.
  #
  #       -- The first  frame should point to ..,f=l; NAME=l.
  #       -- The second frame should point to .,f=r ; NAME=r.
  #
  # -- f=d&d=something (d stands for document)
  #
  #    -- Divide the document into two frames.
  #       -- The first  frame should point to .,f=l; NAME=l.
  #       -- The second frame should point to something; NAME=r.
  #
  # -- f=s (s stands for single)
  #
  #    -- Display the directory in its current frame.
  #
  #       -- The mode switching link should go to plain ".".
  #       -- For .. and . and all other directories, the link should
  #          include f=s.
  #       -- For all other files, the link should be plain.
  #
  # -- f=l (l stands for lefthand)
  #
  #    -- Display the directory in its current frame.
  #
  #       -- The mode switching link should go to .?f=s; TARGET=_top.
  #       -- For .. and . the links should be plain, TARGET=_top.
  #       -- For other directories, the links should be f=r; TARGET=r.
  #       -- For other files, the links should specify TARGET=r.
  #
  # -- f=r (r stands for righthand)
  #
  #    -- Display the directory in its current frame.
  #
  #       -- The mode switching link should go to .?f=s; TARGET=_top.
  #       -- For .. the link should be plain, TARGET=_top
  #       -- For .  the link should go to .,f=r.
  #       -- For other directories, the links should be plain, TARGET=_top.
  #       -- For other files, the links should be .,f=d,d=destination,
  #          TARGET=_top.

  # Correct for any missing destination, just for bulletproofing.

  if((defined($arg_hash{"f"})) &&
     ($arg_hash{"f"} eq "d")
    )
  {
    if((!defined($arg_hash{"d"})) ||
       ($arg_hash{"d"} eq "")
      )
    {
      delete($arg_hash{"d"});
      delete($arg_hash{"f"});
    }
  }

  if((!defined($arg_hash{"f"})) ||
     ($arg_hash{"f"} eq "")
    )
  {
    spit("Content-Type: text/html\n");
    spit("\n");

    spit("<HTML><FRAMESET COLS=\"50%,50%\">\n");

    spit("<FRAME SRC=\"$target_filename/../?f=l\" NAME=l>\n");
    spit("<FRAME SRC=\"$target_filename/?f=r\" NAME=r>\n");

    spit("</FRAMESET></HTML>\n");

    return 0;

  }   # if there's no f parameter
  elsif($arg_hash{"f"} eq "d")
  {
    billylog("f is d");

    spit("Content-Type: text/html");
    spit("\n");

    spit("<HTML><FRAMESET COLS=\"50%,50%\">\n");

    spit("<FRAME SRC=\"./?f=l\" NAME=l>\n");
    spit("<FRAME SRC=\"".$arg_hash{"d"}."/\" NAME=r>\n");

    spit("</FRAMESET></HTML>\n");

    return 0;
  }
  elsif($arg_hash{"f"} eq "s")
  {
    billylog("f is s");
    $param_mode_switching="<A HREF=\".\">";
    $param_2dots="<A HREF=\"$target_filename/..?f=s\">";
    $param_1dot="<A HREF=\"$target_filename?f=s\">";
    $param_dir_1="<A HREF=\"";
    $param_dir_2="?f=s\">";
    $param_file_1="<A HREF=\"";
    $param_file_2="\">";
  }
  elsif($arg_hash{"f"} eq "l")
  {
    billylog("f is l");
    $param_mode_switching="<A HREF=\".?f=s\" TARGET=_top>";
    $param_2dots="<A HREF=\"$target_filename/..\" TARGET=_top>";
    $param_1dot="<A HREF=\"$target_filename\" TARGET=_top>";
    $param_dir_1="<A HREF=\"";
    $param_dir_2="?f=r\" TARGET=r>";
    $param_file_1="<A HREF=\"";
    $param_file_2="\" TARGET=r>";
  }
  elsif($arg_hash{"f"} eq "r")
  {
    billylog("f is r");
    $param_mode_switching="<A HREF=\".?f=s\" TARGET=_top>";
    $param_2dots="<A HREF=\"$target_filename/..\" TARGET=_top>";
    $param_1dot="<A HREF=\"$target_filename?f=r\">";
    $param_dir_1="<A HREF=\"";
    $param_dir_2="\" TARGET=_top>";
    $param_file_1="<A HREF=\".?f=d&d=";
    $param_file_2="\" TARGET=_top>";
  }
  else
  {
    billylog("oops");
    spit("Content-Type: text/plain\n");
    spit("Status: 500 Internal Server Error\n");
    spit("\n");

    return 0;
  }

  {
    # Actually list the directory.

    my $buffer;
    my $dear;
    my $entry;
    my $jndex;
    my $max_group_width;
    my $max_nlink_width;
    my $max_size_width;
    my $max_user_width;
    my $st_dev;
    my $st_ino;
    my $st_mode;
    my $st_nlink;
    my $st_uid;
    my $st_gid;
    my $st_rdev;
    my $st_size;
    my $st_atime;
    my $st_mtime;
    my $st_ctime;
    my $st_blksize;
    my $st_blocks;

    my %filenames;

    if(!opendir($dear,$physical_filename))
    {
      my $status=$!;

      if($status==13)
      {
        spit("Content-Type: text/plain\n");
        spit("Status: 403 Forbidden\n");
        spit("\n");
        spit("403 Forbidden $target_filename\n");

        return 0;
      }
      else
      {
        spit("Content-Type: text/plain\n");
        spit("Status: 404 Not Found\n");
        spit("\n");
        spit("404 Not Found $target_filename\n");

        return 0;
      }
    }

    spit("Content-Type: text/html\n");
    spit("\n");

    spit("<HTML><BODY>\n");

    spit
    ("<TT>".$param_mode_switching."Click here to switch modes.</A>\n");

    spit("<P>ls -l <FONT COLOR=gray>--kinda</FONT> $target_filename<BR>");

    while($entry=readdir($dear))
    {
      if($entry=~/^\./)
      {
        next;
      }

      $filenames{$entry}="X";
    }

    closedir($dear);

    # Get widths of columns.  Grr.

    $max_nlink_width=1;
    $max_size_width =1;
    $max_user_width =0;
    $max_group_width=0;

    foreach $entry (sort(keys(%filenames)))
    {
      ($st_dev,
       $st_ino,
       $st_mode,
       $st_nlink,
       $st_uid,
       $st_gid,
       $st_rdev,
       $st_size,
       $st_atime,
       $st_mtime,
       $st_ctime,
       $st_blksize,
       $st_blocks
      )=stat("$physical_filename/$entry");

      if($max_nlink_width<length($st_nlink))
      {
        $max_nlink_width=length($st_nlink);
      }

      if($max_size_width<length($st_size))
      {
        $max_size_width=length($st_size);
      }

      if($max_user_width<length(etc_passwd($st_uid)))
      {
        $max_user_width=length(etc_passwd($st_uid));
      }

      if($max_group_width<length(etc_group($st_gid)))
      {
        $max_group_width=length(etc_group($st_gid));
      }
    }

    foreach $entry ("..",".",sort(keys(%filenames)))
    {
      spit("<BR><NOBR>");

      if((!-r "$physical_filename/$entry") &&
         ($entry!~/^\./)
        )
      {
        spit("<FONT COLOR=gray>");
      }
      elsif($entry!~/^\./)
      {
        if(-d "$physical_filename/$entry")
        {
          spit($param_dir_1);
        }
        else
        {
          spit($param_file_1);
        }

        for($jndex=0;
            $jndex<length($entry);
            $jndex++
           )
        {
          $buffer=substr($entry,$jndex,1);

          if($buffer!~/[!&()+-;=\?-\[\]-_a-z~]/)
          {
            $buffer="%".unpack("H**",$buffer);
            $buffer=~tr/a-z/A-Z/;
          }

          spit($buffer);
        }

        if(-d "$physical_filename/$entry")
        {
          spit($param_dir_2);
        }
        else
        {
          spit($param_file_2);
        }
      }

         if($entry=~/^\./)                { spit("&nbsp;"); }
      elsif(-f "$physical_filename/$entry") { spit("-"); }
      elsif(-b "$physical_filename/$entry") { spit("b"); }
      elsif(-c "$physical_filename/$entry") { spit("c"); }
      elsif(-d "$physical_filename/$entry") { spit("d"); }
      elsif(-l "$physical_filename/$entry") { spit("l"); }
      elsif(-p "$physical_filename/$entry") { spit("p"); }
      elsif(-S "$physical_filename/$entry") { spit("s"); }
      else                                { spit("?"); }

      if($entry!~/^\./)
      {
        ($st_dev,
         $st_ino,
         $st_mode,
         $st_nlink,
         $st_uid,
         $st_gid,
         $st_rdev,
         $st_size,
         $st_atime,
         $st_mtime,
         $st_ctime,
         $st_blksize,
         $st_blocks
        )=stat("$physical_filename/$entry");
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 0400)
        {
          spit("r");
        }
        else
        {
          spit("-");
        }
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 0200)
        {
          spit("w");
        }
        else
        {
          spit("-");
        }
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 04000)
        {
          if($st_mode & 0100)
          {
            spit("s");
          }
          else
          {
            spit("S");
          }
        }
        else
        {
          if($st_mode & 0100)
          {
            spit("x");
          }
          else
          {
            spit("-");
          }
        }
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 0040)
        {
          spit("r");
        }
        else
        {
          spit("-");
        }
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 0020)
        {
          spit("w");
        }
        else
        {
          spit("-");
        }
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 02000)
        {
          if($st_mode & 0010)
          {
            spit("s");
          }
          else
          {
            spit("S");
          }
        }
        else
        {
          if($st_mode & 0010)
          {
            spit("x");
          }
          else
          {
            spit("-");
          }
        }
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 0004)
        {
          spit("r");
        }
        else
        {
          spit("-");
        }
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 0002)
        {
          spit("w");
        }
        else
        {
          spit("-");
        }
      }

      if($entry=~/^\./)
      {
        spit("&nbsp;");
      }
      else
      {
        if($st_mode & 01000)
        {
          if($st_mode & 0001)
          {
            spit("s");
          }
          else
          {
            spit("S");
          }
        }
        else
        {
          if($st_mode & 0001)
          {
            spit("x");
          }
          else
          {
            spit("-");
          }
        }
      }

      spit("&nbsp;");

      if($entry=~/^\./)
      {
        spit("&nbsp;" x $max_nlink_width);
      }
      else
      {
        spit(fix_spaces(sprintf("%".$max_nlink_width."d",$st_nlink)));
      }

      spit("&nbsp;");

      if($entry=~/^\./)
      {
        spit("&nbsp;" x $max_user_width);
      }
      else
      {
        spit(sprintf(("%-".$max_user_width."s"),etc_passwd($st_uid)));
      }

      spit("&nbsp;");

      if($entry=~/^\./)
      {
        spit("&nbsp;" x $max_group_width);
      }
      else
      {
        spit(sprintf(("%-".$max_group_width."s"),etc_group($st_gid)));
      }

      spit("&nbsp;");

      if($entry=~/^\./)
      {
        spit("&nbsp;" x $max_size_width);
      }
      else
      {
        spit(fix_spaces(sprintf("%".$max_size_width."d",$st_size)));
      }

      spit("&nbsp;");

      if($entry=~/^\./)
      {
        spit("&nbsp;" x 20);
      }
      else
      {
        spit(printable_time($st_mtime));
      }

      spit("&nbsp;");

      if($entry eq "..")
      {
        spit($param_2dots);
      }

      if($entry eq ".")
      {
        spit($param_1dot);
      }

      spit(sanitize($entry));

      if((!-r "$physical_filename/$entry") &&
         ($entry!~/^\./)
        )
      {
        spit("</FONT>");
      }
      else
      {
        spit("</A>");
      }

      spit("</NOBR>\n");
    }

    spit("</TT>");

    spit("</BODY></HTML>\n");
  }

  return 0;

} # handler()

handler();

#