devedit.pl

   1 #!C:/Programme/Perl/bin/perl.exe -w
   2
   3 #
   4 # Dev-Editor
   5 #
   6 # Dev-Editor's main program
   7 #
   8 # Author:        Patrick Canterino <patshaping@gmx.net>
   9 # Last modified: 10-04-2003
  10 #
  11
  12 use strict;
  13 use CGI::Carp qw(fatalsToBrowser);
  14
  15 use vars qw($VERSION
  16             %config);
  17
  18 use lib 'modules';
  19
  20 use CGI;
  21 use Command;
  22 use File::UseList;
  23 use Output;
  24 use Tool;
  25
  26 $VERSION = '1.0';
  27
  28 ### Settings ###
  29
  30 %config = (
  31            fileroot     => 'D:/Server/WWW/dokumente',
  32            httproot     => '/',
  33            timeformat   => '%d.%m.%Y %H:%M',
  34            uselist_file => 'uselist',
  35            lock_file    => 'uselist.lock',
  36            lock_timeout => '10'
  37           );
  38
  39 ### End Settings ###
  40
  41 # Read the most important form data
  42
  43 my $cgi = new CGI;
  44
  45 my $command = $cgi->param('command') || 'show';
  46 my $file    = $cgi->param('file')    || '/';
  47 my $curdir  = $cgi->param('curdir')  || '';
  48 my $newfile = $cgi->param('newfile') || '';
  49
  50 # Create physical and virtual path for the new file
  51 # This section has to be optimized - ugh!
  52
  53 my $new_physical = '';
  54 my $new_virtual  = '';
  55
  56 if($newfile ne '')
  57 {
  58  $curdir  = upper_path($file) if($curdir eq '');
  59  my $path = clean_path($curdir.$newfile);
  60
  61  # Extract file and directory name...
  62
  63  my $file = file_name($path);
  64  my $dir  = upper_path($path);
  65
  66  # ... check if the directory exists ...
  67
  68  unless(-d clean_path($config{'fileroot'}."/".$dir))
  69  {
  70   abort("The directory where you want to create this file or directory doesn't exist.");
  71  }
  72
  73  # ... and check if the path is above the root directory
  74
  75  unless(($new_physical,$new_virtual) = check_path($config{'fileroot'},$dir))
  76  {
  77   abort("You aren't allowed to create files and directories above the virtual root directory.");
  78  }
  79
  80  # Create the physical and the virtual path
  81
  82  $new_physical = File::Spec->canonpath($new_physical."/".$file);
  83  $new_virtual .= $file;
  84 }
  85
  86 # This check has to be performed first, or abs_path() will be confused
  87
  88 if(-e clean_path($config{'fileroot'}."/".$file))
  89 {
  90  if(my ($physical,$virtual) = check_path($config{'fileroot'},$file))
  91  {
  92   # Copied from old Dev-Editor (great idea)
  93
  94   my %dispatch = ('show'         => \&exec_show,
  95                   'beginedit'    => \&exec_beginedit,
  96                   'canceledit'   => \&exec_unlock,
  97                   'endedit'      => \&exec_endedit,
  98                   'mkdir'        => \&exec_mkdir,
  99                   'mkfile'       => \&exec_mkfile,
 100                   'workwithfile' => \&exec_workwithfile,
 101                   'copy'         => \&exec_copy,
 102                   'rename'       => \&exec_rename,
 103                   'remove'       => \&exec_remove,
 104                   'unlock'       => \&exec_unlock
 105                  );
 106
 107   # Create a File::UseList object and load the list
 108
 109   my $uselist = new File::UseList(listfile => $config{'uselist_file'},
 110                                   lockfile => $config{'lock_file'},
 111                                   timeout  => $config{'lock_timeout'});
 112
 113   $uselist->lock or abort("Locking of $config{'uselist_file'} failed. Try it again in a moment. If the problem persists, ask someone to recreate the lock file ($config{'lock_file'}).");
 114   $uselist->load;
 115
 116   # Create a hash with data submitted by user
 117   # (the CGI and the File::UseList object will also be included)
 118
 119   my %data = (physical     => $physical,
 120               virtual      => $virtual,
 121               new_physical => $new_physical,
 122               new_virtual  => $new_virtual,
 123               uselist      => $uselist,
 124               cgi          => $cgi);
 125
 126   unless($dispatch{$command})
 127   {
 128    $uselist->unlock;
 129    abort("Unknown command: $command");
 130   }
 131
 132   my $output = &{$dispatch{$command}}(\%data,\%config); # Execute the command...
 133
 134   $uselist->unlock; # ... unlock the list with used files...
 135   print $$output;   # ... and print the output of the command
 136  }
 137  else
 138  {
 139   abort("Accessing files and directories above the virtual root directory is forbidden.");
 140  }
 141 }
 142 else
 143 {
 144  abort("File/directory does not exist.");
 145 }
 146
 147 #
 148 ### End ###