Cook results from the CPAN

Cook

Apache2-FileManager

view release on metacpan or search on metacpan


Apache2::FileManager - Apache2 mod_perl File Manager

=head1 SYNOPSIS

 # Install in mod_perl enabled apache conf file
  <Location /FileManager>
    SetHandler           perl-script
    PerlHandler          Apache2::FileManager
  </Location>

  (Then point your browser to http://www.yourwebsite.com/FileManager)

 # Or call from your own mod_perl script
  use Apache2::FileManager;
  my $obj = Apache2::FileManager->new();
  $obj->print();

 # Or create your own custom MyFileManager subclass

 package MyFileManager;
 use strict;
 use Apache2::FileManager;

 our @ISA = ('Apache2::FileManager');

 sub handler {
   my $r = shift;
   my $obj = __PACKAGE__->new();
   $r->content_type('text/html');
   $r->print ("
    <HTML>
      <HEAD>
        <TITLE>".$r->hostname." File Manager</TITLE>
      </HEAD>
   ");
   $obj->print();
   $r->print("</HTML>");
 }

 # .. overload the methods ..


=head1 DESCRIPTION

The Apache2::FileManager module is a simple HTML file manager.  It provides
file manipulations such as cut, copy, paste, delete, rename, extract archive,
create directory, create file, edit file, and upload files.

Apache2::FileManager also has the ability to rsync the server htdocs tree to
another server with the click of a button.


=head1 PREREQUISITES

The following (non-core) perl modules must be installed before installing
Apache2::FileManager.

 Apache/mod_perl => 2.0
 Archive::Any    => 0.03
 CGI::Cookie     => 1.20
 File::NCopy     => 0.32
 File::Remove    => 0.20

=head1 SPECIAL NOTES

Make sure the web server has read, write, and execute access access to the
directory you want to manage files in. Typically you are going to want to
run the following commands before you begin.

chown -R nobody /web/xyz/htdocs
chmod -R 755 /web/xyz/htdocs

The extract functionality only works with *.tar.gz and *.zip files.

=head1 RSYNC FEATURE

To use the rync functionality you must have ssh, rsync, and the L<File::Rsync>
perl module installed on the development server. You also must have an sshd 
running on the production server.

Make sure you always fully qualify your server names so you don't have 
different values in your known hosts file.

 For Example:
 ssh my-machine                -  wrong
 ssh my-machine.subnet.com     -  right

Note: If the ip address of the production_server changes you will need to
create a new known_hosts file.

To get the rsync feature to work do the following:

 #1 log onto the production server

 #2 become root

 #3 give web server user (typically nobody) a home area
   I made mine /usr/local/apache/nobody
   - production_server> mkdir /usr/local/apache/nobody
   - edit passwd file and set new home area for nobody
   - production_server> mkdir /usr/local/apache/nobody/.ssh

 #4 log onto the development server

 #5 become root

 #6 give web server user (typically nobody) a home area
   - dev_server> mkdir /usr/local/apache/nobody
   - dev_server> chown -R nobody.nobody /usr/local/apache/nobody
   - edit passwd file and set new home area for nobody
   - dev_server> su - nobody
   - dev_server> ssh-keygen -t dsa      (don't use passphrase)
   - dev_server> ssh production_server 
     (will fail but will make known_hosts file)
   - log out from user nobody back to root user
   - dev_server> cd /usr/local/apache/nobody/.ssh
   - dev_server> scp id_dsa.pub production_server:/usr/local/apache/nobody/.ssh/authorized_keys
   - dev_server> chown -R nobody.nobody /usr/local/apache/nobody
   - dev_server> chmod -R 700 /usr/local/apache/nobody

FileManager.pm view on Meta::CPAN

   </Location>

 # Or specify different document root in your own mod_perl script
   use Apache2::FileManager;
   my $obj = Apache2::FileManager->new({
     DOCUMENT_ROOT => '/web/project/htdocs/newroot'
   });
   $obj->print();

=head1 SUBCLASSING Apache2::FileManager

 # Create a new file with the following code:

 package MyProject::MyFileManager;
 use strict;
 use Apache2::FileManager;
 our @ISA = ('Apache2::FileManager');

 #Add your own methods here

 1;

The best way to subclass the filemanager would be to copy the methods you want
to overload from the Apache2::FileManager file to your new subclass. Then change
the methods to your liking.

=head1 BUGS

There is a bug in L<File::NCopy> that occurs when trying to paste an empty
directory. The directory is copied but reports back as 0 directories pasted.
The author is in the process of fixing the problem.

=head1 AUTHOR

L<Apache::FileManager> was written by
Philip Collins E<lt>pmc@cpan.orgE<gt>.

L<Apache2::FileManager> was adapted for Apache2 by
David Aguilar E<lt>davvid@cpan.orgE<gt>.

=cut

use strict;
use warnings;
use Apache2::Log ();
use Apache2::Util ();
use Apache2::Const -compile => qw(OK DECLINED);
use Apache2::Request ();
use Apache2::RequestIO ();
use Apache2::RequestRec ();
use Apache2::RequestUtil ();
use Apache2::ServerUtil ();
use Apache2::Upload;
use IO::File;
use File::NCopy  qw(copy);
use File::Copy   qw(move);
use File::Remove qw(remove);
use File::stat;
use Archive::Any;
use POSIX qw(strftime);
use CGI::Cookie;
#use Data::Dumper;

require 5.005_62;

our $VERSION = '0.20';

sub r { return Apache2::Request->new(Apache2::RequestUtil->request) }

# ---------- Object Constructor -----------------------------------------
sub new {
  my $package = shift;
  my $attribs = shift || {};
  my $o = bless $attribs, $package;
  $o->intialize();
  $o->execute_cmds();
  return $o;
}


# ---- If this was called directly via a perl content handler by apache -------
sub handler {
  my $r = Apache2::Request->new(@_);
  return Apache2::Const::DECLINED if defined r->param('nossi');
  my $package = __PACKAGE__;
  my $obj = $package->new();
  r->content_type('text/html');
  r->print("<HTML><HEAD><TITLE>"
           .r->hostname." File Manager $VERSION</TITLE></HEAD>");
  $obj->print();
  r->print("</HTML>");
  return Apache2::Const::OK;
}


# ---- Call the view ----------------------------------------------
sub print {
  my $o = shift;

  my $view = "view_".$$o{'view'};
  $o->$view();
}


# ------------ Intialize object -----------------------------------------
sub intialize {
  my $o = shift;

  $$o{MESSAGE} = "";
  $$o{JS} = "";
  $$o{EDIT_COLS} ||= 75;
  $$o{EDIT_ROWS} ||= 22;


  # Is this filemanager rsync capable?
  $$o{RSYNC_TO} ||= r->dir_config('RSYNC_TO') || undef;

  #set some defaults (for warnings sake)

  $$o{FILEMANAGER_cmd} = r->param('FILEMANAGER_cmd') || "";
  $$o{FILEMANAGER_arg} = r->param('FILEMANAGER_arg') || "";

FileManager.pm view on Meta::CPAN

sub html_bottom {
  return "
      <TABLE WIDTH=100% CELLPADDING=0 CELLSPAING=0><TR>
      <TD ALIGN=RIGHT VALIGN=TOP>
          <A HREF=http://www.cpan.org/modules/by-module/Apache/PMC
             TARGET=CPAN
          ><FONT SIZE=-1 COLOR=BLACK>Apache2-FileManager-$VERSION</FONT></A>
      </TD>
      </TR>
      </TABLE>";
}





##############################################################################
# -------------- Utility Methods ------------------------------------------- #
##############################################################################

sub execute_cmds {
  my $o = shift;
  my $cmd = r->param('FILEMANAGER_cmd');
  my $arg = r->param('FILEMANAGER_arg');
  my $method = "cmd_$cmd";
  if ($o->can($method)) {
    $o->$method($arg);
  }
}


sub get_selected_files {
  my @sel_files = r->param('FILEMANAGER_sel_files');
  return \@sel_files;
}


sub filename_esc {
  #escape spaces in filename
  my $o = shift;
  my $f = shift;
  $f =~ s/\ /\\\ /g;
  return $f;
}


sub formated_date {
  my $o = shift;
  my $date = shift || time;
  return strftime "%D %l:%M %P", localtime($date);
}


sub get_clip_board {
  my $o = shift;

  #get copy and cut file arrays
  my $buffer_type = "";
  my $buffer_filenames = [];

  if (defined(r->headers_in->{'Cookie'})) {
    my $cookie_name = uc(r->hostname());
    $cookie_name =~ s/[^A-Z]//g;
    $cookie_name .= "_FM";
    my %cookies = CGI::Cookie->parse(r->headers_in->{'Cookie'});
    if (exists $cookies{$cookie_name}) {
      my $data = $cookies{$cookie_name}->value;
      my @ar = split /\|/, $data;

      #is there something in buffer
      if ($#ar > 0) {
        $buffer_type      = pop @ar;
        $buffer_filenames = \@ar;
      }
    }
  }
  return ($buffer_type, $buffer_filenames);
}





###############################################################################
# -- Commands (called via form input from method execute_cmds or manually) -- #
###############################################################################

sub cmd_savefiledata {
  my $o = shift;

  my $base = r->param('FILEMANAGER_editfile');
  $base =~ /([^\/]+)$/;
  my $filename = $1;
  remove $filename;
  my $fh = IO::File->new("> ".$filename);
  print $fh scalar(r->param('FILEMANAGER_filedata'));
  $$o{MESSAGE} = "file saved";
  $$o{view} = "pre_editfile";
  return undef;
}


sub cmd_editfile {
  my $o = shift;

  my $base = r->param('FILEMANAGER_editfile');
  $base =~ /([^\/]+)$/;
  my $filename = $1;

  if (! -e $filename) {
    my $fh = IO::File->new("> ".$filename);
    if ($fh) {
      $$o{JS} .= "
        if (window.opener && window.opener.document.FileManager) {
          window.opener.document.FileManager.submit();
        }";
    }
  }
  $$o{view} = "pre_editfile";
}


sub cmd_paste {
  my $o = shift;
  my $arg1 = shift;

( run in 0.451 second using v1.01-cache-2.11-cpan-d06a3f9ecfd )