#!/usr/bin/perl -Tw

#======================================================================
# fm.cgi -- file-manager-0.01, let your users have their own personal
#           web sites under your domain!
#
# Copyright (C) 2000  Colin Kong
#
# 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.
#
#======================================================================

# $Id: fm.cgi,v 1.1.1.1 2000/06/16 17:22:52 ckyc Exp $

#=============================================================
# Begin edit.

# Uncomment the following line and edit the path if you have
# installed LibWeb into non-standard Perl's library locations.
#use lib '/path/to/LibWeb';

# Where is your LibWeb rc (config) file located?
# (Absolute path; NOT url).
my $_rc_file = '/home/my_site/lw_rc_file';

# Where did you put the image files (*.png) for file manager?  If you
# do not specify here, file manager will use the default, namely the
# PIX_URL in your libweb rc file.  Note the trailing slash.
my $_pix_url = '/images/';

# How much disk space (in bytes) do you give to each user?
# 5 Mb in the following example.
my $_disk_quota = 1024 * 1024 * 5;

# What file types should be disabled?  All files end with these
# extensions will be deleted upon `Upload', `Create file' and
# `Directory listing'.
my $_disallowed_exts = ['php','exe','cgi','pl','py','htaccess'];

# Do you disable users to upload to your server? (1 if yes; 0 if no)
my $_is_disable_upload = 0;

# How large (in bytes) a file do you allow users upload to your
# server?  1.5 Mb in the following example.
my $_per_file_upload_limit = 1024 * 1024 * 1.5;

# Send an alert e-mail to the site administrator (rc: ADMIN_EMAIL)
# after each upload by users?  (1 if yes; 0 if no)
my $_is_upload_alert_admin = 1;

# What is the relative url and absolute path to your users' documents?
# Note the trailing trashes.  According to the following example, if
# colin is the login name of one of your site's members, then his
# personal web site's address will be http://www.your_site.org/user/colin
my $_user_url_root = '/user/';
my $_user_doc_root = '/home/my/htdocs/user/';

# fm-0.01 is not NT friendly.  Too lazy to program a subroutine to
# traverse a whole directory tree to find the total files' size.  You
# may have to edit the path so that it point to `du' at your server;
# type ``whereis du'' on your command line to find out.  For NT
# server, disable this fuction by assigning 0 to $_is_check_disk_usage
my $_find_disk_usage_cmd = '/usr/bin/du -s';
my $_is_check_disk_usage = 1;

# Do you run this script with perl's taint mode turned on?  I.e., did
# you put `#!/usr/bin/perl -Tw' instead of `#!/usr/bin/perl -w' on the
# first line of this script?  Read #3 in the `Bugs' section of README
# carefully.
my $_is_taint_mode_on = 1;

# For debugging cgi script via a web browser.
# Should be commented out in production release of this script.
use CGI::Carp qw(fatalsToBrowser);

# End edit.
#=============================================================

# Make perl taint mode happy.
$ENV{PATH} = "";

# Use standard libraries.
use strict;
use File::stat;
##require DirHandle;
##require FileHandle;
##require File::Copy;
##require File::Path;
##use Fcntl;

# Use custom libraries.
require LibWeb::HTML::Default;
require LibWeb::Themes::Default;
require LibWeb::Session;
require LibWeb::CGI;
require LibWeb::File;

#=============================================================
# LibWeb's objects.
my $html = new LibWeb::HTML::Default($_rc_file);
my $themes = new LibWeb::Themes::Default();
my $q = new LibWeb::CGI(
			-post_max => $_per_file_upload_limit,
			-disable_uploads => $_is_disable_upload
		       );
my $a = new LibWeb::Session();

#=============================================================
# Authentication.  Very important.
my ($user, $uid) = $a->is_login();

#=============================================================
# CGI paramters.
my $p_a = '.a';
my $p_file_name = '.file_name';
my $p_new_file_name = '.new_file_name';
my $p_relative_dir = '.dir';
my $p_texts = '.texts';
my $p_fm_editor_rows = '.fm_editor_rows';
my $p_fm_editor_columns = '.fm_editor_columns';
my $p_resize_editor = '.resize';
my $p_save = '.save';
my $p_save_and_keep_edit = '.save_and_keep_edit';
my $p_editor_preview = '.editor_preview';
my $p_cancel = '.cancel';
my @p_upload_files = ( '.upload_file0', '.upload_file1', '.upload_file2',
		       '.upload_file3', '.upload_file4', );

#============================================================
# CGI actions.
my $a_list_dir = 'list_dir';
my $a_confirm_delete = 'confirm_delete';
my $a_confirm_rename = 'confirm_rename';
my $a_delete = 'delete';
my $a_rename = 'rename';
my $a_create_dir = 'create_dir';
my $a_overwrite = 'overwrite';
my $a_edit = 'edit';
my $a_upload = 'upload';

#============================================================
# Misc. variables.
my $this = $ENV{SCRIPT_NAME};
my $disk_quota = $_disk_quota;
my $is_upload_alert_admin = $_is_upload_alert_admin;
my $path_sep = $a->{PATH_SEP};
my $this_user_url_root = $_user_url_root. "$user/";
my $this_user_doc_root = $_user_doc_root . $user . $path_sep;
my $this_user_index_htm = $this_user_doc_root . 'index.htm';
my $pix_url = $_pix_url || $a->{PIX_URL};
my $dir_icon = $pix_url.'icon_dir.png';
my $file_icon = $pix_url.'icon_file.png';
my $home_icon = $pix_url.'icon_home.png';
my $dot_grey = $pix_url.'dot_grey.png';
my $dot_orange = $pix_url.'dot_orange.png';
my $fm_editor_default_rows = '15';    # Should be fetched from user preference table.
my $fm_editor_default_columns = '60'; # Should be fetched from user preference table.
                                      # not yet supported in this version.
my $find_disk_usage_cmd = $_find_disk_usage_cmd;

#=============================================================
# Parse CGI parameters.
my $action = _parse_action();
my $file_name = _parse_file_name();
my $new_file_name = _parse_new_file_name();
my $relative_dir = _parse_relative_dir();
my $relative_url = defined($relative_dir) ?
                   $this_user_url_root . "$relative_dir/" : $this_user_url_root;
my $abs_dir = defined($relative_dir) ?
              $this_user_doc_root . $relative_dir . $path_sep : $this_user_doc_root;

#=============================================================
# Main.
if ($action eq $a_list_dir) { List_dir(); }
elsif ($action eq $a_confirm_delete) { Confirm_delete(); }
elsif ($action eq $a_confirm_rename) { Confirm_rename(); }
elsif ($action eq $a_delete) { Delete(); }
elsif ($action eq $a_rename) { Rename(); }
elsif ($action eq $a_upload) { Upload(); }
elsif ($action eq $a_edit) { Editor(); }
elsif ($action eq $a_create_dir) { Create_dir(); }
elsif ($action eq $a_overwrite) { Overwrite(); }
else { List_dir(); }

exit(0);

#=============================================================
# External subroutines.
sub List_dir {
    #
    # Print out a dir(cgi param) listing in HTML.
    #
    # Post:
    #  1. Delete any file with extension described in $_disallowed_exts.
    #  2. List all files in current directory except hidden files (.*).
    #

    #my $dir = new DirHandle($abs_dir);
    #my @files = $dir->read(); $dir->close(); # put eval here.
    my (@files, $file, $file_name, $file_abs_path, $stat, $size, $last_modified,
	$is_text_file, $is_dir, $item_icon, $action, $target_dir, $delete, $rename,
	$edit, @table_headings, @table_rows, $row, $dir_list);

    # Delete sticky CGI params.
    $q->delete_all();
    $q->autoEscape(undef);

    _is_user_home_dir_exist();
    _is_target_dir_exist();

    # Open the target directory.
    opendir(DIR, $abs_dir);
    @files = readdir(DIR) or
      $a->fatal(-msg => 'Cannot read directory',
		-input => $relative_url,
		-helpMsg => _directory_error_hhtml())
	if ( !defined(@files) );
    closedir(DIR);

    # Prepare the display for directory listing.
    @table_headings = ('File size', 'Last modified', 'File/dir', 'Delete', 'Rename');
    @table_rows = $q->td(\@table_headings);

    foreach $file (sort @files) {

	$file_abs_path = $abs_dir . $file; 
	
	# Delete any unwanted files.
	_delete_disallowed_file_type($abs_dir, $file);
	
	# Skip present working directory, parent directory and hidden files.
	next if ($file =~ m:^[.]:);
	
	# Fetch the stat for that file.
	$stat = stat($file_abs_path) or
	  $a->fatal( -msg => 'Cannot locate file.',
		     -input => $file,
		     -alertMsg => 'fm::List_dir() error: '.$abs_dir.$file." $!"
		   );
	    #if ( !defined($stat) );

	# File/dir size in kilobytes.
	$size = int($stat->size / 1024);
	$size = $size?$size:1; # Since file size appear to be 0 if below 1 Kb.
	$size =  $size . ' Kb';

 	# File's last modified date and time.
	$last_modified = localtime($stat->mtime);

	# Determine item's icon, display name and operation.
	# Try to put stat test together since those operations are expensive.
	($is_text_file, $is_dir) = (-T $file_abs_path, -d _);
	if ($is_dir) {
	    $item_icon = $dir_icon;
	    $action = $a_list_dir;
	    $target_dir = defined($relative_dir) ? "$relative_dir/".$file : $file;
	} else {
	    $item_icon = $file_icon;
	    $action = $a_edit;
	    $target_dir = $relative_dir;
	}

	# Possible operations on file.
	$edit = "?$p_a=$action&$p_relative_dir=$target_dir&$p_file_name=$file";
	$delete = "?$p_a=$a_confirm_delete&$p_relative_dir=$relative_dir&$p_file_name=$file";
	$rename = "?$p_a=$a_confirm_rename&$p_relative_dir=$relative_dir&$p_file_name=$file";

	$delete = $q->a( {-href=>$this.$delete}, 'Delete' );
	$rename = $q->a( {-href=>$this.$rename}, 'Rename' );

	$file_name = $q->img( {-src=>$item_icon, -border=>0, -width=>16, -height=>16} ). ' ';
	$file_name .= ($is_dir || $is_text_file) ?
	              $q->a( {-href=>$this.$edit}, $file ) : $file;
		  
	$row = [$size, $last_modified, $file_name, $delete, $rename];
	push ( @table_rows, $q->td($row) );

    }

    $dir_list = $q->table( {-border => 0, -width => '100%', -cellspacing => 0,
			    -cellpadding => 7}, $q->Tr(\@table_rows) );

    $q->autoEscape(undef);
    print $q->header();
    print ${ _directory_listing_html( \$dir_list ) };
}

sub Confirm_delete {
    #
    # Display a Web page to ask for user confirmation to delete a file or a
    # a directory and all contents underneath that directory.
    #

    # Delete sticky CGI param values.
    $q->delete_all();
    print $q->header();
    print ${_confirm_delete_html()};
}

sub Delete {
    #
    # Delete a single file or a directory and all files and directories underneath
    # that directory.  Reload and print out current working directory.
    #
    my ($abs_path_to_file, $is_exist, $is_dir);

    if ( $q->parameter($p_cancel) ) { List_dir(); return undef; };
    ($abs_path_to_file, $is_exist, $is_dir, undef) = _get_target_file_stat();

    # Does the file/dir exist?
    $a->fatal(-msg => "File/directory does not exist.",
	      -input => $file_name,
	      -alertMsg => 'fm::Delete() error: ' .
	                   "$abs_path_to_file doesn't exist.",
	      -helpMsg => $html->hit_back_and_edit())
      unless ($is_exist);

    # Delete the target.  File::Path::rmtree(), rmdir() and unlink().
    if ($is_dir) {

        if ($_is_taint_mode_on) {
	    $abs_path_to_file =~ m:(.*):; 
	    rmdir($1) ||
	      $a->fatal(-msg => "Could not delete directory which is not empty.",
			-input => $file_name,
			-alertMsg => "fm::Delete() error: $! [$abs_path_to_file ".
			'could not be deleted because it is not empty]',
			-helpMsg => _could_not_delete_non_empty_dir());
		undef $1;
	} else {
	    require File::Path;
	    # This won't make taint mode happy since there are stuff in
	    # directories.  This is a BUG, cannot delete a whole dir when
	    # running this script with perl's taint mode on.
	    $abs_path_to_file =~ m:(.*):; 
	    File::Path::rmtree($1) ||
	      $a->fatal(-msg => "Could not delete directory.",
			-input => $file_name,
			-alertMsg => "fm::Delete() error: $! " .
			"$abs_path_to_file could not be deleted.",
			-helpMsg => $html->hit_back_and_edit());
	    undef $1;
	}

    } else {
	$abs_path_to_file =~ m:(.*):;
	unlink($1) ||
	  $a->fatal(-msg => "Could not delete file.",
		    -input => $file_name,
		    -alertMsg => 'fm::Delete() error: ' .
		                 "$abs_path_to_file could not be deleted.",
		    -helpMsg => $html->hit_back_and_edit());
    }

    List_dir();
}

sub Confirm_rename {
    #
    # Display a Web page to ask for user confirmation to rename a file or a
    # a directory.  A text input field is provided.
    #

    # Delete sticky CGI param values.
    $q->delete_all();
    print $q->header();
    print ${_confirm_rename_html()};
}

sub Rename {
    #
    # Rename a file or a directory.  Reload and print the current working directory.
    #
    my ($abs_path_to_old_file, $is_exist, $abs_path_to_new_file);

    if ( $q->parameter($p_cancel) ) { List_dir(); return undef; };
    ($abs_path_to_old_file, $is_exist, undef, undef) = _get_target_file_stat();

    # Does the old file/dir exist?
    $a->fatal(-msg => 'File/directory does not exist.',
	      -input => $file_name,
	      -alertMsg => 'fm::Rename(): attempt to rename ' .
	                   "$abs_path_to_old_file which doesn't exist",
	      -helpMsg => $html->hit_back_and_edit())
      unless ($is_exist);

    # Check to see if new file name is entered by user.
    $a->fatal(-msg => 'New file/directory name not entered.',
	      -alertMsg => 'fm::Rename(): attempt to rename ' .
	                   "$abs_path_to_old_file with null",
	      -helpMsg => $html->hit_back_and_edit())
      unless defined($new_file_name);

    $abs_path_to_new_file = $abs_dir . $new_file_name;

    # Does this file has an illegal extension?
    unless ( _is_file_type_ok($new_file_name) ) {
	$a->fatal(
		  -alertmsg =>
		  "$user attempted to rename $abs_path_to_old_file to ".
		  "$abs_path_to_new_file which has illegal extension.",
		  -isDisplay => 0
		 );
	List_dir();
	return undef;
    }

    # Is the new name already in use?
    if ( -e $abs_path_to_new_file ) { Confirm_overwrite(); }
    else {
	# Rename the file/dir.
	#require File::Copy; File::Copy::move(src,dst);
	$abs_path_to_old_file =~ m:(.*):;
	my $old = $1; undef $1;
	$abs_path_to_new_file =~ m:(.*):;
	my $new = $1; undef $1;
	rename($old, $new) ||
	  $a->fatal(-msg => 'Could not rename file/directory.',
		    -input => $file_name . ' => ' . $new_file_name,
		    -alertMsg => $abs_path_to_old_file . ' => ' .
		                 $abs_path_to_new_file,
		    -helpMsg => _directory_error_hhtml());

	List_dir();
    }
}

sub Confirm_overwrite {
    #
    # Display a Web page to ask for user confirmation to overwrite a file or a
    # a directory and make a back up of the old file/directory.
    #

    # Delete sticky CGI param values.
    $q->delete_all();
    print $q->header();
    print ${_confirm_overwrite_html()};
}

sub Overwrite  {
    #
    # Make a back up of the original $new_file_name (new_file.time_stamp) and
    # rename $file_name to $new_file_name.
    #
    
    my ($abs_path_to_old_file, $abs_path_to_new_file, $is_exist);

    if ( $q->parameter($p_cancel) ) { List_dir(); return undef; };

    ($abs_path_to_old_file, $is_exist, undef, undef) = _get_target_file_stat();

    $a->fatal(-msg => 'File/directory does not exist.',
	      -input => $file_name,
	      -alertMsg => 'fm::Overwrite(): attempt to rename ' .
	                   "$abs_path_to_old_file which doesn't exist",
	      -helpMsg => $html->hit_back_and_edit())
      unless ($is_exist);

    $a->fatal(-msg => 'New file/directory does not exist.',
	      -alertMsg => 'fm::Overwrite(): attempt to overwrite something ' .
	                   'which doesn\'t exist',
	      -helpMsg => $html->hit_back_and_edit())
      unless defined($new_file_name);
    
    $abs_path_to_new_file = $abs_dir . $new_file_name;

    if ( $abs_path_to_old_file eq $abs_path_to_new_file )
      { List_dir(); return undef; };

    # Make a back up of the new, existing file/directory.
    # Any security problem here?  What if the file size is huge?
    require File::Copy;
    $abs_path_to_new_file =~ m:(.*):;    
    File::Copy::move( $1, "${1}.".time() ) ||
      $a->fatal(-msg => 'Could not backup file/directory.',
		-input => $new_file_name,
		-alertMsg => 'fm::Overwrite(): cp ' .
		             "$abs_path_to_new_file ${abs_path_to_new_file}.old",
		-helpMsg => _directory_error_hhtml());

    # Rename the old file/dir to the new file/dir name.
    $abs_path_to_old_file =~ m:(.*):;
    my $old = $1; undef $1;
    $abs_path_to_new_file =~ m:(.*):;
    my $new = $1; undef $1;
    rename($old, $new) ||
      $a->fatal( -msg => 'Could not overwrite file/directory.',
		 -input => $file_name . ' => ' . $new_file_name,
		 -alertMsg => 'fm::Overwrite(): rename ' .
		              "$abs_path_to_old_file => $abs_path_to_new_file",
		 -helpMsg => _directory_error_hhtml() );

    List_dir();
}

sub Create_dir {
    #
    # Args: $abs_path_to_dir.
    #
    # Create a new directory in the current working directory.
    # Reload and print out a listing for the current working directory.
    #
    my ($abs_path_to_new_dir, $new_dir_name);

    # Get the new dir name entered by user.
    $new_dir_name = $new_file_name;
    $html->fatal(-msg => 'New directory name not entered.',
		 -alertMsg => "fm::Create_dir: attempt to mkdir with null",
		 -helpMsg => $html->hit_back_and_edit())
      unless defined($new_dir_name);

    # Is the name already in use?
    $abs_path_to_new_dir = $abs_dir . $new_dir_name;
    if ( -e $abs_path_to_new_dir ) {
	$a->fatal(
		  -msg => 'Directory exists already.',
		  -input => $new_dir_name,
		  -alertMsg => "$user attempted to create $abs_path_to_new_dir ".
		  'which exists already.',
		  -helpMsg => $html->hit_back_and_edit()
		 );
    } else {
	# Make the new directory.
	# File::Path::mkpath($dir,0,0711) or mkdir($dir,0711).
	# require File::Path;
	$abs_path_to_new_dir =~ m:(.*):;
	mkdir($1, 0711) ||
	  $a->fatal(-msg => 'Could not make new directory.',
		    -input => $new_dir_name,
		    -alertMsg => 'fm::Create_dir(): could not mkdir: ' .
		                 "$abs_path_to_new_dir.",
		    -helpMsg => _directory_error_hhtml());
	undef $1;
	List_dir();
    }
}

sub Editor {
    #
    # Pre:
    # - $p_file_name must be defined.
    # - $p_a=$a_edit [, $p_save/$p_save_and_keep_edit/$p_resize_editor defined/
    #   $p_editor_preview ].
    # - if $p_resize_editor is defined, then $my $p_texts, $p_fm_editor_rows and
    #   $p_fm_editor_column must also be defined.
    # - if $p_save/$p_save_and_keep_edit is defined, then $p_texts must also be
    #   defined.
    #
    # Post:
    # - Check to see if the $file_name exists already, if not, create it and
    #   display an edit screen.  Print an error msg and abort the program if
    #   $file_name exists and it is not a text file.
    # - print contents of $p_texts if $p_editor_preview is defined.
    # - resize the editor and re-display it with the texts if $p_resize_editor
    #   is defined.  Also save the editor's size ($p_fm_editor_rows and
    #   $p_fm_editor_columns) to user preference table (database).
    # - save the texts to $file_name if $p_save_and_keep_edit is defined and
    #   re-display the editor.
    # - save the texts to $file_name if $p_save is defined and display current
    #   working directory.
    #
    my ($FH, $abs_path_to_file, $is_exist, $is_dir, $is_text, $lines);
    $lines =  [ $q->parameter($p_texts) ];

    $q->autoEscape(1);

    # Resize the text editor.
    if ( defined $q->parameter($p_resize_editor) ) {
	my ($rows, $columns);
	$rows = $q->parameter( $p_fm_editor_rows );
	$columns = $q->parameter( $p_fm_editor_columns );
	# save user preference to database (not in this version) #######
	print $q->header();
	print $ { _text_file_editor_html( $lines, $rows, $columns ) };
	return undef;
    }
    
    ($abs_path_to_file, $is_exist, $is_dir, $is_text) = _get_target_file_stat();

    # HTML page preview.
    if ( defined $q->parameter($p_editor_preview) ) {
	print $q->header();
	print $lines->[0] if ( $lines->[0] );
	return undef;
    }
    
    $a->fatal( -msg => 'Cannot edit directory.',
	       -input => $file_name,
	       -alertMsg => "fm::Editor(): attempt to edit $abs_path_to_file.",
	       -helpMsg => $html->hit_back_and_edit() )
      if ($is_dir);

    $a->fatal( -msg => 'Cannot edit non-text file.',
	       -input => $file_name,
	       -alertMsg => "fm::Editor(): attempt to edit $abs_path_to_file.",
	       -helpMsg => $html->hit_back_and_edit() )
      unless ( $is_text || !$is_exist );

    # Does this file has an illegal extension?
    unless ( _is_file_type_ok($file_name) ) {
	$a->fatal(
		  -alertmsg =>
		  "$user attempted to create illegal file: $abs_path_to_file",
		  -isDisplay => 0
		 );
	List_dir();
	return undef;
    }

    # Open/create the file.
    #sysopen($FH, $abs_path_to_file, 'O_RDWR|O_CREAT', '0644');
    #print $q->header(); print $abs_path_to_file; exit(0);
    #new FileHandle("O_WRONLY|O_CREATE");
    require FileHandle; use Fcntl;
    $FH = new FileHandle();
    $FH->open( $abs_path_to_file, O_RDONLY|O_CREAT ) ||
      $a->fatal( -msg => 'Could not open/create file.',
		 -input => $file_name,
		 -alertMsg =>
		 "fm::Editor(): $! attempt to open $abs_path_to_file.",
		 -helpMsg => _directory_error_hhtml() );
    
    # Read lines from $file_name if it's the first time invoking this text editor.
    unless ( defined $lines->[0] ) {
	my @lines;
	eval { @lines = ($is_exist) ? $FH->getlines() : (); };
	$a->fatal( -msg => 'Could not read lines from file.',
		   -input => $file_name,
		   -alertMsg =>
		   "fm::Editor(): $@ attempt to getlines from $abs_path_to_file.",
		   -helpMsg => _directory_error_hhtml() )
	  if ($@);
	$lines = \@lines;
    }

    # Save the texts to $file_name.
    if ( defined $q->parameter($p_save_and_keep_edit) ||
	 defined $q->parameter($p_save) ) {
	$abs_path_to_file =~ m:(.*):;
	LibWeb::File->new()->write_lines_to_file(
						 -file => $1,
						 -lines => $lines
						) ||
	  $a->fatal( -msg => 'Could not save file.',
		     -input => $file_name,
		     -alertMsg => "fm::Editor(): could not save $abs_path_to_file.",
		     -helpMsg => '_directory_error_hhtml()' );
    }

    # Close $file_name.
    $FH->close() ||
      $a->fatal( -msg => 'Could not close file properly.',
		 -input => $file_name,
		 -alertMsg => "fm::Editor(): attempt to close $abs_path_to_file.",
		 -helpMsg => _directory_error_hhtml() );

    if ( defined $q->parameter($p_save) ) { List_dir(); return undef; }
    else {
	print $q->header();
	print ${ _text_file_editor_html($lines) };
    }
}

sub Upload {
    #
    # Post: - Rename the tmp file (uploaded) to the desired name (will
    # overwrite any existing file without warning (but will make a
    # backup of the file being overwritten) and send an email to admin
    # notifying of the event.
    #
    my ($FH, $abs_tmp_file, $abs_target_file, $abs_target_tmp_file,
	$the_file_name, $size, $is_already_exist, $upload_report);

    foreach (@p_upload_files) {
	# Get the abs tmp file name (uploaded) and the absolute target file name.
	next unless $FH = $q->upload($_);
	$abs_tmp_file = $q->tmpFileName( $q->parameter($_) );
	$q->parameter($_) =~ m|([^:/\\]+)$|;
	$the_file_name = $1;
	undef $1;
	$abs_target_tmp_file = $abs_dir . $the_file_name . time();
	$abs_target_file = $abs_dir . $the_file_name;
	       
	# This happens if the file's size > $per_upload_limit.
	# Actually, this will be caught in $q->parameter($_) already,
	# but it's here for double safety so to speak.
	$a->fatal( -msg => "File's size exceeds limit.",
		   -helpMsg => _exceed_upload_limit_hhtml() )
	  if ( !$FH && $q->cgi_error() );
	
	($is_already_exist, $size) = ( -e $abs_target_file, -s $abs_tmp_file );

	# Is this uploaded file making disk usage > quota ?
	$a->fatal( -msg => 'Exceeded disk quota.  Upload has been aborted.',
		   -input => $the_file_name,
		   -alertMsg => "fm::Upload(): the size is $size" .
		                "$abs_tmp_file => $abs_target_file",
		   -helpMsg => _exceed_disk_quota_hhtml() )
	  if ( _get_total_disk_usage() + $size > $disk_quota );

	# Move the CGI tmp file to current working directory.
	# This should be done as soon as possible since CGI tmp file seems to
	# be vanishing very quickly?
	require File::Copy;
	$abs_tmp_file =~ m:(.*):;
	my $tmp = $1; undef $1;
	$abs_target_tmp_file =~ m:(.*):;
	my $target_tmp = $1; undef $1;
	File::Copy::move( $tmp, $target_tmp ) ||
	  $a->fatal( -msg => 'Could not receive your file.',
		     -input => $the_file_name,
		     -alertMsg => "fm::Upload(): File::Copy::move failed, $!" .
		     "$abs_tmp_file => $abs_target_file",
		     -helpMsg => _upload_failed_hhtml() );

	# Make a backup copy before overwrite file that exists already before
	# upload.
	if ($is_already_exist) {
	    $abs_target_file =~ m:(.*):;
	    rename( $1, "${1}.".time() );
	    undef $1;
	}
	$abs_target_file =~ m:(.*):;
	File::Copy::move( $target_tmp, $1  ) ||
	  $a->fatal( -msg => 'Could not receive your file properly.',
		     -input => $the_file_name,
		     -alertMsg => "fm::Upload(): File::Copy::move failed, $!" .
		     "$abs_tmp_file => $abs_target_file",
		     -helpMsg => _upload_failed_hhtml() );
    
	chmod( 0644, $1 ) ||
	  $a->fatal(
		    -input => $the_file_name,
		    -alertMsg =>
		    "fm::Upload(): could not chmod 644 $abs_target_file: $!",
		    -isDisplay => 0
		   );

	# Delete unwanted files.
	_delete_disallowed_file_type($abs_dir, $1);
	
	$upload_report .=
	  "\nUploaded file: $abs_target_file\nFile size: $size bytes.\n";
    }

    # Send admin an upload report.
    $a->fatal(
	      -alertMsg => "$user uploaded the following file(s):\n$upload_report",
	      -isDisplay => 0
	     )
      if ($_is_upload_alert_admin);

    List_dir();
}

#================================================================================
# Internal subroutines.
sub _is_file_type_ok {
    #
    # Params: the_file_name
    #
    # Example: _is_file_type_ok('file.php')
    #
    # Post:
    # - return 1 if the file's extension does not belong to any one of those
    #   described in $_disallowed_exts; return 0 otherwise. 
    #
    my ($file) = @_;
    foreach (@$_disallowed_exts) {
	if ( $file =~ m:^.*[.]$_.*$:i ) {
	    return 0;
	}
    }    
    return 1;
}

sub _delete_disallowed_file_type {
    #
    # Params: absolute_path_to_a_file, the_file_name
    #
    # Example:
    #    _delete_disallowed_file_type('/home/me/htdocs/user/$user/', 'file.php')
    #
    # Post:
    # - Delete the file if its extension is one of the disallowed extensions
    #   decribed in $_disallowed_Exts.
    # - return 1 and send an alert e-mail to the site administrator
    #   (rc: ADMIN_EMAIL) upon deletion; return 0 if file passed extension test.
    #
    my ($path, $file) = @_;
    foreach (@$_disallowed_exts) {
	unless ( _is_file_type_ok($file) ) {

	    my $abs_target_file = $path.$file;

	    # Delete that file!
	    $abs_target_file =~ m:(.*):;
	    unlink($1) ||
	      $a->fatal(
			-alertMsg => 'fm::_check_file_type() error: ' .
			"$abs_target_file (illegal file) could not be deleted!",
			-isDisplay => 0
		       );
	    undef $1;

	    # Send an alert e-mail to the site admin.
	    $a->fatal(
		      -alertMsg =>
		      "$user uploaded illegal file: $abs_target_file ".
		      'and it has been successfully deleted.',
		      -isDisplay => 0
		     );
	    
	    return 1;
	}
    }
    
    return 0;
}

sub _get_total_disk_usage {
    #
    # Return total disk usage in bytes.
    #

    # For NT server.
    return 0 unless ($_is_check_disk_usage);

    my $cmd = "$find_disk_usage_cmd $this_user_doc_root";

    # Prevent executing malicious command in case user some how able
    # to attach extra commands to it.  Is it enough? No.  What is the
    # equivalent on NT?
    $cmd =~ s:[\;].*::g;

    # Satisfies perl's taint mode.
    $cmd =~ m:(.*):;
    my $disk_usage = `$1`;
    $disk_usage =~ m:^(.+)\s+.+$:;
    return $1 * 1024;
}

sub _is_target_dir_exist {
    #
    # Test to see if the target dir exist.  Return 1 if true.
    #
    $a->fatal(-msg => 'Directory does not exist.',
	      -input => $relative_url,
	      -alertMsg => 'fm::_is_target_dir_exist() error. ' .
	                   "$abs_dir does not exist.",
	      -helpMsg => _directory_error_hhtml())
      unless (-e $abs_dir);
    return 1;
}

sub _get_target_file_stat {
    #
    # Print out an error message and abort the program if the file_name cgi param
    # is not defined.
    # Otherwise, return an absolute path to $file_name and three booleans indicating
    # whether the target exist, whether the file is a directory and whether it is a
    # text file.
    #
    my $abs_path_to_file;

    # Is the CGI parameter for file_name defined?
    $a->fatal(-msg => 'File/directory name not entered.',
	      -alertMsg => 'fm::_get_target_file_stat() error: '.
	                   'file_name parameter\'s value missing',
	      -helpMsg => $html->hit_back_and_edit())
      unless defined($file_name);

    # Try to group stat tests together since they are expensive.
    $abs_path_to_file = $abs_dir . $file_name;
    return ($abs_path_to_file, -e $abs_path_to_file, -d _, -T _);
}

sub _is_user_home_dir_exist {
    #
    # Test to see if user has home directory created and an index.htm(|l);
    # create it if not and put a copy of default index.htm there.
    # Test only when requesting to list user home dir since stat tests are expensive.
    #
    # Return 1 if user home dir exist.
    # Return -1 if it's not tested.
    #
    if ($abs_dir eq $this_user_doc_root) {
	unless (-e $this_user_doc_root) {

	    $this_user_doc_root =~ m:(.*):;
	    mkdir($1, 0711) ||
	      $a->fatal(-msg => 'Cannot create or find your home directory.',
			-alertMsg => "fm::_is_user_home_dir_exist() error: $!, ".
			"$this_user_doc_root cannot be found or created.",
			-helpMsg => _directory_error_hhtml());
	    undef $1;

	    $this_user_index_htm =~ m:(.*):;
	    LibWeb::File->new()->
	      write_lines_to_file(
				  -file => $1,
				  -lines => [ $ {_default_user_index_html()} ]
				 )
		||
		  $a->fatal(-msg => 'Cannot create or find your index.htm.',
			    -alertMsg => "fm::is_user_home_dir_exist() error: $!, ".
			    "$this_user_index_htm could not be found or created.",
			    -helpMsg => _no_index_hhtml());
	    chmod(0644, $1) ||
	      $a->fatal( -input => $this_user_index_htm,
			 -alertMsg => "fm::_is_user_home_dir_exist(): $! ".
			 "could not chmod 644 $this_user_index_htm",
			 -isDisplay => 0 );
	    undef $1;

	}
	return 1;
    }
    return -1;
}

#=============================================================================
# Parse CGI parameters.  Security sensitive.
#
# Note: one important thing is to prevent user manipulating `../' which links
#       up one directory from current working directory.
# Other security notes should be added here.
sub _parse_relative_dir {
    # `/', `-', `.' and `_' are ommitted from the list below since they are
    # needed for dir names and url path separator.
    my $meta = '\`\~\!\@\#\$\%\^\&\*\,\:\;\?\"\'\<\>\{\}\[\]\(\)\\\|\+\=';
    my $relative_dir = $q->parameter($p_relative_dir);
    return undef unless defined($relative_dir);

    $a->fatal(-msg => 'File/directory cannot contain special characters.',
	      -input => $relative_dir,
	      -alertMsg => "FM error[_parse_relative_dir()]: $relative_dir " .
	                   'File/directory name contains meta characters.',
	      -helpMsg => $html->special_characters_not_allowed())
      if ($relative_dir =~ m:[$meta]:g);
    $a->fatal(-msg => 'File/directory cannot contain space characters.',
	      -input => $relative_dir,
	      -alertMsg => "FM error[_parse_relative_dir()]: $relative_dir " .
	                   'File/directory name contains space characters.',
	      -helpMsg => $html->special_characters_not_allowed())
      if ($relative_dir =~ m:\s:g);
    $a->fatal(-msg => 'Invalid file/directory name.',
	      -input => $relative_dir,
	      -alertMsg => "FM error[_parse_relative_dir()]: $relative_dir",
	      -helpMsg => _directory_error_hhtml())
      unless ($relative_dir =~ m:^\w+:);
    $a->fatal(-msg => 'Directory name must contain at least one and at most '.
	              '30 characters.',
	      -input => $relative_dir,
	      -alertMsg => "FM error[_parse_relative_dir()]: $relative_dir",
	      -helpMsg => $html->hit_back_and_edit())
      unless ($relative_dir =~ m:^.{1,100}$:);

    if ( $relative_dir =~ m:^([^$meta]+)$: ) {
	return defined($1) ? $1 : undef;
    }
    return undef;
}

sub _parse_file_name {
    # `.', `-' and `_' are ommitted from the list since it's needed for
    # file names and file extensions.
    my $meta = '\`\~\!\@\#\$\%\^\&\*\,\:\;\?\"\'\<\>\{\}\[\]\(\)\\\|\/\+\=';
    my $file_name = $q->parameter($p_file_name);
    return undef unless defined($file_name);

    $a->fatal(-msg => 'File/directory name cannot contain special characters.',
	      -input => $file_name,
	      -alertMsg => "FM error[_parse_file_name()]: $file_name " .
	                   'file name contains meta characters.',
	      -helpMsg => $html->special_characters_not_allowed())
      if ($file_name =~ m:[$meta]:g);
    $a->fatal(-msg => 'File/directory name cannot contain space characters.',
	      -input => $file_name,
	      -alertMsg => "FM error[_parse_file_name()]: $file_name " .
	                   'file name contains space characters.',
	      -helpMsg => $html->special_characters_not_allowed())
      if ($file_name =~ m:\s:g);
    $a->fatal(-msg => 'File/directory name must contain at least one and at most '.
	              '30 characters.',
	      -input => $file_name,
	      -alertMsg => "FM error[_parse_file_name()]: $file_name",
	      -helpMsg => $html->hit_back_and_edit())
      unless ($file_name =~ m:^.{1,100}$:);
    $a->fatal(-msg => 'Invalid file/directory name.',
	      -input => $file_name,
	      -alertMsg => "FM error[_parse_file_name()]: $file_name",
	      -helpMsg => $html->hit_back_and_edit())
      unless ($file_name =~ m:^\w+:);

    if ( $file_name =~ m:^([^$meta]+)$: ) {
	return defined($1) ? $1 : undef;
    }
    return undef;
}

sub _parse_new_file_name {
    # `.', `-' and `_' are ommitted from the list since it's needed for
    # file names and file extensions.
    my $meta = '\`\~\!\@\#\$\%\^\&\*\,\:\;\?\"\'\<\>\{\}\[\]\(\)\\\|\/\+\=';
    my $new_file_name = $q->parameter($p_new_file_name);
    return undef if ( !defined($new_file_name) or $q->parameter($p_cancel) );

    $a->fatal(-msg => 'File/directory name cannot contain special characters.',
	      -input => $new_file_name,
	      -alertMsg => "FM error[_parse_new_file_name()]: $new_file_name " .
	                   'file name contains meta characters.',
	      -helpMsg => $html->special_characters_not_allowed())
      if ($new_file_name =~ m:[$meta]:g);
    $a->fatal(-msg => 'File/directory name cannot contain space characters.',
	      -input => $new_file_name,
	      -alertMsg => "FM error[_parse_new_file_name()]: $new_file_name " .
	                   'file name contains space characters.',
	      -helpMsg => $html->special_characters_not_allowed())
      if ($new_file_name =~ m:\s:g);
    $a->fatal(-msg => 'File/directory name must contain at least one and at most '.
	              '30 characters.',
	      -input => $new_file_name,
	      -alertMsg => "FM error[_parse_new_file_name()]: $new_file_name",
	      -helpMsg => $html->hit_back_and_edit())
      unless ($new_file_name =~ m:^.{1,100}$:);
    $a->fatal(-msg => 'Invalid file/directory name.',
	      -input => $new_file_name,
	      -alertMsg => "FM error[_parse_new_file_name()]: $new_file_name",
	      -helpMsg => $html->hit_back_and_edit())
      unless ($new_file_name =~ m:^\w+:);

    if ( $new_file_name =~ m:^([^$meta]+)$: ) {
	return defined($1) ? $1 : undef;
    }
    return undef;
}

sub _parse_action {
    my $operation = $q->parameter($p_a);
    return undef unless defined($operation);
    return $operation;
}

#===============================================================================
# Page constructs.
sub _sheader {
    return undef;
}

sub _lpanel {
    return undef;
}

sub _rpanel {
    return [ _my_home_page_phtml() ];
}

sub _header {
    return undef;
}

sub _footer {
    return undef;
}

#==============================================================================
# fm HTML.
sub _default_user_index_html {
    my $msg;
    $msg = "<H1>We're sorry but $user hasn't uploaded her/his personal web page yet.  ".
           "Please check back soon for updates or visit <A href=\"/\">$html->{SITE_NAME}</A>.</H1>";
    return $html->display(
			  -content => [ \$msg ],
			  -header => undef,
			  -sheader => undef,
			  -lpanel => undef,
			  -rpanel => undef,
			  -footer => undef
			 );
}

sub _confirm_overwrite_html {
    my ($msg, $msg_display, $spacer);

    $q->autoEscape(undef);

    # Prepare the display.
    $spacer = $q->br() x 4; # Determine the valign of the confirmation msg.
    $msg = "WARNING: <font color=\"red\">$new_file_name</font> already exists.  " .
           "Make a backup of <font color=\"red\">$new_file_name</font> and " .
	   "replace it and all of its contents with " .
	   "<font color=\"red\">$file_name</font>?";
    $msg .= $q->startform(-action =>$this);
    $msg .=  $q->hidden( -name=>$p_a, -default=>$a_overwrite ) .
             $q->hidden( -name=>$p_relative_dir, -default=>$relative_dir ) .
	     $q->hidden( -name=>$p_file_name, -default=>$file_name ) .
	     $q->hidden( -name=>$p_new_file_name, -default=>$new_file_name );
    $msg .= $q->table( {-width=>'100%'},
		       $q->Tr( $q->td( {-align=>'right'},
				       $q->submit(-name => $p_cancel, -value=>'cancel'),
				       $q->submit(-name => 'confirm') ) ) );
    $msg .= $q->end_form();

    $msg_display = $themes->titled_bordered_table(-content => [\$msg],
						-title => 'Confirmation',
						-bg_color => $a->{SITE_LIQUID_COLOR1});
    return $html->display( -content => [\$spacer, $msg_display],
			    -sheader => _sheader(), -lpanel => _lpanel(),
			    -rpanel => _rpanel(),
			    -footer => _footer(), -header => _header() );
}

sub _confirm_delete_html {
    my ($msg, $msg_display, $spacer);

    $q->autoEscape(undef);

    # Prepare the display.
    $spacer = $q->br() x 4; # Determine the valign of the confirmation msg.
    $msg = "Delete <font color=\"red\">$file_name</font> and all contents in it?";
    $msg .= $q->startform(-action =>$this);
    $msg .=  $q->hidden( -name=>$p_a, -default=>$a_delete ) .
             $q->hidden( -name=>$p_relative_dir, -default=>$relative_dir ) .
	     $q->hidden( -name=>$p_file_name, -default=>$file_name );
    $msg .= $q->table( {-width=>'100%'},
		       $q->Tr( $q->td( {-align=>'right'},
				       $q->submit(-name => $p_cancel, -value=>'cancel'),
				       $q->submit(-name => 'confirm') ) ) );
    $msg .= $q->end_form();

    $msg_display = $themes->titled_bordered_table(-content => [\$msg],
						-title => 'Confirmation',
						-bg_color => $a->{SITE_LIQUID_COLOR1});
    return $html->display( -content => [\$spacer, $msg_display],
			    -sheader => _sheader(), -lpanel => _lpanel(),
			    -rpanel => _rpanel(),
			    -footer => _footer(), -header => _header() );
}

sub _confirm_rename_html {
    my ($msg, $msg_display, $txt_field, $spacer);

    $q->autoEscape(undef);

    # Prepare the display.
    $spacer = $q->br() x 4; # Determine the valign of the confirmation msg.
    $txt_field = $q->textfield(-name => $p_new_file_name, -default => $file_name,
			       -size => '20', -maxlength => '30', -override => 1);
    $msg = "Please type a new name for <font color=\"red\">$file_name</font>.";
    $msg .= $q->startform(-action =>$this);
    $msg .=  $q->hidden( -name=>$p_a, -default=>$a_rename ) .
             $q->hidden( -name=>$p_relative_dir, -default=>$relative_dir ) .
	     $q->hidden( -name=>$p_file_name, -default=>$file_name );
    $msg .= $q->table( {-width=>'100%'},
		       $q->Tr( $q->td( {-align=>'right'},
				       $txt_field,
				       $q->submit(-name => $p_cancel, -value=>'cancel'),
				       $q->submit(-name => 'confirm') ) ) );
    $msg .= $q->end_form();

    $msg_display = $themes->titled_bordered_table(-content => [\$msg],
						-title => 'Confirmation',
						-bg_color => $a->{SITE_LIQUID_COLOR1});
    return $html->display( -content => [\$spacer, $msg_display],
			    -sheader => _sheader(), -lpanel => _lpanel(),
			    -rpanel => _rpanel(),
			    -footer => _footer(), -header => _header() );
}

sub _directory_listing_html {
    #
    # Args: $dir_list
    #
    # Pre:
    # - $dir_list is an SCALAR ref. to HTML presentation of a directory listing.
    #
    my ($dir_list_display);
    $dir_list_display = $themes->titled_table_enlighted( -title => $relative_url,
							 -content => [ $_[0] ] );
    return $html->display( -content =>
			   [ _fm_menu_bar_phtml(), $dir_list_display,
			     _disk_usage_phtml(), _create_text_file_phtml(),
			     _create_dir_phtml(), _upload_file_phtml() ],
			   -sheader => _sheader(), -lpanel => _lpanel(),
			   -rpanel => _rpanel(),
			   -header => _header(), -footer => _footer() );
}

sub _text_file_editor_html {
    #
    # Args: $lines [, $rows, $columns]
    #       $lines is an ARRAY ref. to lines of the text file to be edited.
    #       $rows is the default number of rows in <textarea>.
    #       $columns is the default number of columns in <textarea>.
    #
    my ($lines, $rows, $columns, $hiddens, $cwd, $menu_bar, $editor,
	$editor_display);
    ($lines, $rows, $columns) = @_;
    $rows = $fm_editor_default_rows unless defined($rows);
    $columns = $fm_editor_default_columns unless defined($columns);
    local ($") = '';

    # Hiddens.
    $hiddens = $q->hidden( -name=>$p_a, -default=>$a_edit ) .
               $q->hidden( -name=>$p_relative_dir, -default=>$relative_dir ) .
	       $q->hidden( -name=>$p_file_name, -default=>$file_name );
    
    # Current working directory.
    $cwd = $themes->table( -content => [ _cwd_phtml() ], -align => 'right' );

    # Text editor's menu bar.
    $menu_bar = $q->reset() .
		$q->submit( -name => $p_save_and_keep_edit,
			    -value => 'save and continue edit' ) .
		$q->submit( -name => $p_save, -value => 'save' ) .
		$q->submit( -name=> $p_editor_preview, -value => 'preview' ) .
		$q->br() .
		'Rows: ' . $q->popup_menu( -name => $p_fm_editor_rows,
					   -values => [15,20,30,40,50,60,80,90],
					   -default => $rows ) .
	       'Columns: ' . $q->popup_menu( -name => $p_fm_editor_columns,
					     -values => [10,20,30,40,50,60,80],
					     -default => $columns ) .
	        $q->submit( -name => $p_resize_editor,
			    -value => 'resize' );

    # The text editor.
    $editor = $q->startform( -action => $this ) .
              $q->textarea( -name => $p_texts, -default => "@{ $lines }",
			    -rows => $rows, -columns => $columns, -override => 1
			  ) . "\n" . $hiddens .
	      $q->start_table( {-width=>'100%', -border=>0} ) .
	      $q->Tr( $q->td( {-align=>'center'}, $menu_bar ) ) .
	      $q->end_table() . $q->end_form();

    # Prepare the display.
    $editor_display =
      $themes->titled_bordered_table( 
				     -content => [\$editor],
				     -title => $relative_url.$file_name,
				     -border_color => $a->{SITE_LIQUID_COLOR3},
				     -bg_color => $a->{SITE_LIQUID_COLOR1},
				     -align => 'center'
				    );
    return $html->display( 
			  -content => [$cwd, $editor_display],
			  -sheader => _sheader(), -lpanel => _lpanel(),
			  -rpanel => _rpanel(),
			  -footer => _footer(), -header => _header()
			 );
}

#=================================================================================
# fm PHTML.
sub _my_home_page_phtml {
    my $return;
    $return = $q->img( {-src=>$home_icon, -border=>0, -alt=>'my home page',
			-width=>16, -height=>16} ) .
	      $q->a( {-href=>$this_user_url_root}, ' My home page' );
    return \$return;
}

sub _fm_menu_bar_phtml {
    return \$q->table(
		      {-border=>0, -width=>'100%'},
		      $q->Tr(
			     $q->td( {-align=>'right'}, $ {_parent_dir_phtml()} )
			    )
		     );
}

sub _parent_dir_phtml {
    my ($parent_dir,$return);
    if ( defined($relative_dir) ) {
	$parent_dir = ( $relative_dir =~ m:^(.*)/: ) ? $1 : '';
	$return = $q->img( {src=>$dir_icon} ) . ' ' .
	          $q->a( {href=>$this."?$p_a=$a_list_dir&$p_relative_dir=$parent_dir"},
			 'Parent directory' );
	return \$return;
    } else {
	return \ (' ');
    }
}

sub _disk_usage_phtml {
    return \(' ') unless ($_is_check_disk_usage);
    my ($disk_usage, $percentage, $return);
    $disk_usage = _get_total_disk_usage();
    $percentage = int(  $disk_usage / $disk_quota * 100 );
    $return = $q->start_table( {-width=>'100%'} ) .
              $q->start_Tr() .
	      $q->td(
		     {-align=>'right'},
		     'Disk usage: ' .
		     $q->img( {-src => $dot_orange, -width => $percentage, -height => 10} ).
		     $q->img( {-src => $dot_grey, -width => 100-$percentage, -height => 10} ).
		     '&nbsp;'x2 . $disk_usage/1024 . ' / ' . $disk_quota/1024 . ' Kb'
		    ) .
		$q->end_Tr() .
		$q->end_table();
    return \$return;
}

sub _create_dir_phtml {
    my ($hiddens, $form);
    # Hiddens.
    $hiddens = $q->hidden( -name=>$p_a, -default=>$a_create_dir ) .
               $q->hidden( -name=>$p_relative_dir, -default=>$relative_dir );

    $form = '<SMALL>' . $q->start_form( -action => $this ) . $hiddens .
            $q->textfield( -name => $p_new_file_name, -maxlength => 30,
			   -override => 1 ) .
	    $q->submit( -name => 'submit', -value => 'creat directory' ) .
	    $q->end_form() . '</SMALL>';

    #return $themes->table( -content => [\$form] );
    return \$form;
}

sub _create_text_file_phtml {
    my ($hiddens, $form);
    # Hiddens.
    $hiddens = $q->hidden( -name=>$p_a, -default=>$a_edit ) .
               $q->hidden( -name=>$p_relative_dir, -default=>$relative_dir );

    $form = '<SMALL>' . $q->start_form( -action => $this ) . $hiddens .
            $q->textfield( -name => $p_file_name, -maxlength => 30,
			   -override => 1 ) .
	    $q->submit( -name => 'submit', -value => 'create file' ) .
	    $q->end_form() . '</SMALL>';

    #return $themes->table( -content => [\$form] );
    return $form;
}

sub _upload_file_phtml {
    return \(' ') if ($_is_disable_upload);
    my ($per_file_upload_limit, $hiddens, $form);
    $per_file_upload_limit = $_per_file_upload_limit / (1024*1024);

    # Hiddens.
    $hiddens = $q->hidden( -name=>$p_a, -default=>$a_upload ) .
               $q->hidden( -name=>$p_relative_dir, -default=>$relative_dir );
    $form = '<SMALL>' . $q->start_multipart_form( -action => $this ) . $hiddens .
            $q->filefield( -name => $p_upload_files[0], -maxlength => 100,
			   -override => 1 ) . $q->br() . 
            $q->filefield( -name => $p_upload_files[1], -maxlength => 100,
			   -override => 1 ) . $q->br() .
            $q->filefield( -name => $p_upload_files[2], -maxlength => 100,
			   -override => 1 ) . $q->br() .
            $q->filefield( -name => $p_upload_files[3], -maxlength => 100,
			   -override => 1 ) . $q->br() .
            $q->filefield( -name => $p_upload_files[4], -maxlength => 100,
			   -override => 1 ) . $q->br() .
	    "Max ${per_file_upload_limit}Mb per file " .
	    $q->submit( -name => 'submit', -value => 'upload file(s)' ) .
	    $q->end_form() . '</SMALL>';
    #return $themes->table( -content => [\$form] );
    return \$form;
}

sub _cwd_phtml {
    my ($cwd);
    $cwd = $q->img( {src=>$dir_icon} ) . ' ' .
      $q->a( { href=>"${this}?$p_a=$a_list_dir&$p_relative_dir=$relative_dir" },
	     'Working directory' );
    return \$cwd;
}

#=============================================================
# fm HHTML.
sub _no_index_hhtml {
return \<<HTML;

<P>Please <A HREF="javascript:history.go(-1);">click here</A> or hit
the ``back'' button on your browser and create a file named
\`index.htm\' (without the quotes).</P>

HTML
}

sub _could_not_delete_non_empty_dir {
    return $html->hit_back_and_edit();
}

sub _directory_error_hhtml {
    return $html->hit_back_and_edit();
}

sub _exceed_upload_limit_hhtml {
    return $html->hit_back_and_edit();
}

sub _exceed_disk_quota_hhtml {
    return $html->hit_back_and_edit();
}

sub _upload_failed_hhtml {
    return $html->hit_back_and_edit();
}
