Apache2-FileManager

 view release on metacpan or  search on metacpan

FileManager.pm  view on Meta::CPAN

package Apache2::FileManager;

=head1 NAME

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

FileManager.pm  view on Meta::CPAN


  my @cmds = (

    #Refresh
    "<A HREF=# onclick=\"
        var f=window.document.FileManager;
        f.submit();
        return false;\"
        ><FONT COLOR=WHITE><B>refresh</B></FONT></A>",

    #Edit
    "<A HREF=# onclick=\"
        window.edit_file(); return false;\"
        ><FONT COLOR=WHITE><B>edit</B></FONT></A>",

    #Cut
    "<A HREF=# onclick=\"
        window.save_names('cut'); return false;\"
        ><FONT COLOR=WHITE><B>cut</B></FONT></A>",

    #Copy
    "<A HREF=# onclick=\"
        window.save_names('copy'); return false;\"
        ><FONT COLOR=WHITE><B>copy</B></FONT></A>",

    #Paste
    "<A HREF=# onclick=\"
        if (window.getcookie(cookie_name) != '') {
          var f=window.document.FileManager;
          f.FILEMANAGER_cmd.value='paste'; f.submit();
        } else {
          window.alert('Please select file(s) to paste by checking '+
                       'the file(s) first and clicking copy or cut.');
        }
        return false;\"
        ><FONT COLOR=WHITE><B>paste</B></FONT></A>",

    #Delete
    "<A HREF=# onclick=\"
      var f=window.document.FileManager;
      if (get_num_checked() == 0) {
        window.alert('Please select a file to delete by clicking'+
                     ' on a check box with the mouse.');
        } else {
          var msg = '\\n                 Are you sure?\\n' +
                    '\\n' + 'Click OK to delete selected ' +
                    'files & directories\\n' +
                    '   ***including*** files in those directories';

          if (window.confirm(msg)) {
            f.FILEMANAGER_cmd.value='delete'; f.submit();
          }
        }
        return false; \"
        ><FONT COLOR=WHITE><B>delete</B></FONT></A>",

    #Rename
    "<A HREF=# onclick=\"
        var f=window.document.FileManager;
        if (get_num_checked() != 1) {
          window.alert('Please select ONE file to rename by clicking on a '+
                       'check box with the mouse.');
        } else {
          var rv=window.prompt('enter new name','');
          if ((rv != null) && (rv != '')) {
            f.FILEMANAGER_cmd.value='rename';
            f.FILEMANAGER_arg.value=rv;
            f.submit();
          }
        }
        return false;\"
        ><FONT COLOR=WHITE><B>rename</B></FONT></A>",

    #Extract
    "<A HREF=# onclick=\"
        var f=window.document.FileManager;
        if (get_num_checked() == 0) {
          window.alert('Please select a file to extract by clicking on a '+
                       'check box with the mouse.');
        } else {
          f.FILEMANAGER_cmd.value='extract';
          f.submit();
        }
        return false;\"
        ><FONT COLOR=WHITE><B>extract</B></FONT></A>",

    #New File
    "<A HREF=# onclick=\"
        var f=window.document.FileManager;
        var rv = window.prompt('new file name','');
        var cd = f.FILEMANAGER_curr_dir.value;
        if (cd != '') {
          rv = cd+'/'+rv;
        }
        if ((rv != null) && (rv != '')) {
          var w = window.open('".r->uri."?FILEMANAGER_cmd=editfile".
                                        "&FILEMANAGER_curr_dir='+escape(cd)+'".
                                        "&FILEMANAGER_editfile='+escape(rv),
                              'FileManagerEditFile',
                              'scrollbars,resizable');
          w.focus();

        } else if (rv == '') {
          window.alert('can not create blank file names');
        }
        return false; \">
        <FONT COLOR=WHITE><B>new file</B></FONT></A>",

    #New Directory
    "<A HREF=# onclick=\"
        var f=window.document.FileManager;
        var rv=window.prompt('new directory name','');
        if ((rv != null) && (rv != '')) {
          f.FILEMANAGER_arg.value=rv;
          f.FILEMANAGER_cmd.value='mkdir';
          f.submit();

        } else if (rv == '') {
          window.alert('can not create blank directory names');
        }
        return false;\"
        ><FONT COLOR=WHITE><B>new directory</B></FONT></A>",

    #Upload
    "<A HREF=# onclick=\"
        window.print_upload();
        return false;\"
        ><FONT COLOR=WHITE><B>upload<B></FONT></A>"
  );

  #Rsync
  my $rsync = "";

FileManager.pm  view on Meta::CPAN

  return undef;
}


sub cmd_extract {
  my $o = shift;
  my $arg1 = shift;
  my $sel_files = $o->get_selected_files();
  foreach my $f (@{ $sel_files }) {
    my $esc = $o->filename_esc($$o{DR}."/".$f);
    my $archive = Archive::Any->new($esc);
    $archive->extract if defined $archive;
    $$o{MESSAGE} = "Files extracted.";
  }
  return undef;
}


sub cmd_upload {
  my $o = shift;
  my $arg1 = shift;
  my $count = 0;

  foreach my $i (1 .. 10) {
    my @ar = split /\/|\\/, r->param("FILEMANAGER_file$i");
    next if ($#ar == -1);
    my $filename = pop @ar;
    $filename =~ s/[^\w\ \d\.\-]//g;
    next if ($filename eq "");

    $count++;

    my $up = r->upload("FILEMANAGER_file$i");
    #next if not defined $up;

    #my $in_fh = $up->fh;
    #next if !defined $in_fh;

    my $path = $$o{DR}."/".r->param('FILEMANAGER_curr_dir')."/".$filename;
    $up->link($path);

    #my $arg = "> ".$$o{DR}."/".r->param('FILEMANAGER_curr_dir')."/".$filename;
    #my $out_fh;
    #open($out_fh, $arg)
    #  or die "ERROR: cannot open '$arg'";

    #next if not defined $out_fh;

    #while (<$in_fh>) {
    #  print $out_fh $_;
    #}
    #close($out_fh);

  }
  #$$o{MESSAGE} = "$count file(s) uploaded.";
  $$o{'view'} = "post_upload";
  return undef;
}


sub cmd_rename {
  my $o = shift;
  my $arg1 = shift;
  my $sel_files = $o->get_selected_files();
  my $file = $$o{DR}."/".$sel_files->[0];
  my $bool = move($file, $arg1);
  if ($bool) {
    $$o{MESSAGE} = "File renamed.";
  } else {
    $$o{MESSAGE} = "File could not be renamed.";
  }
  return undef;
}


sub cmd_rsync {
  my $o = shift;
  my $arg1 = shift;
  $$o{'SSH_PATH'} ||= r->dir_config('SSH_PATH');

  #try some default paths for ssh if we can't find ssh
  for (qw(/usr/bin/ssh /usr/local/bin/ssh)) {
    last if $$o{'SSH_PATH'};
    $$o{'SSH_PATH'} = $_ if (-f $_);
  }

  eval "require File::Rsync";
  if ($@) {
    r->log_error($@);
    $$o{MESSAGE} = "Module File::Rsync not installed.";
  } else {
    my $obj = File::Rsync->new( {
      'archive'    => 1,
      'compress'   => 1,
      'rsh'        => $$o{'SSH_PATH'},
      'delete'     => 1,
      'stats'      => 1
    } );

    $obj->exec( { src  => r->document_root(),
                  dest => $$o{'RSYNC_TO'}    } )
      or warn "rsync failed\n";
    $$o{MESSAGE} = join("<BR>", @{ $obj->out }) if ($obj->out);
    $$o{MESSAGE} = join("<BR>", @{ $obj->err }) if ($obj->err);
  }
  $$o{'view'} = "post_upload";
  return undef;
}


sub cmd_mkdir {
  my $o = shift;
  my $arg1 = shift;
  my $bool = mkdir $arg1;
  if ($bool) {
    $$o{MESSAGE} = "New directory added.";
  } else {
    $$o{MESSAGE} = "Could not make directory.";
  }
  return undef;
}


"righty-o";



( run in 0.656 second using v1.01-cache-2.11-cpan-39bf76dae61 )