]>
git.p6c8.net - devedit.git/blob - devedit.pl
7a27e586c220a9f3895f2f7b3ca21788562faf99
1 #!C:/Programme/Perl/bin/perl.exe -w
6 # Dev-Editor's main program
8 # Author: Patrick Canterino <patshaping@gmx.net>
9 # Last modified: 2004-02-06
13 use CGI
:: Carp
qw(fatalsToBrowser) ;
25 use constant CONFIGFILE
=> 'devedit.dat' ;
27 # Read the configuration file
29 my $config = read_config
( CONFIGFILE
);
30 error_template
( $config ->{ 'tpl_error' }); # Yes, I'm lazy...
32 # Read the most important form data
36 my $command = $cgi -> param ( 'command' ) || 'show' ;
37 my $file = $cgi -> param ( 'file' ) || '/' ;
38 my $curdir = $cgi -> param ( 'curdir' ) || '' ;
39 my $newfile = $cgi -> param ( 'newfile' ) || '' ;
41 # Create physical and virtual path for the new file
42 # This section has to be optimized - ugh!
44 my $new_physical = '' ;
49 $curdir = upper_path
( $file ) if ( $curdir eq '' );
50 my $path = clean_path
( $curdir . $newfile );
52 # Extract file and directory name...
54 my $file = file_name
( $path );
55 my $dir = upper_path
( $path );
57 # ... check if the directory exists ...
59 unless (- d clean_path
( $config ->{ 'fileroot' }. "/" . $dir ))
61 abort
( "The directory where you want to create this file or directory doesn't exist." );
64 # ... and check if the path is above the root directory
66 unless (( $new_physical , $new_virtual ) = check_path
( $config ->{ 'fileroot' }, $dir ))
68 abort
( $config ->{ 'err_creat_ar' });
71 # Create the physical and the virtual path
73 $new_physical = File
:: Spec
-> canonpath ( $new_physical . "/" . $file );
74 $new_virtual .= $file ;
77 # This check has to be performed first, or abs_path() will be confused
79 if (- e clean_path
( $config ->{ 'fileroot' }. "/" . $file ))
81 if ( my ( $physical , $virtual ) = check_path
( $config ->{ 'fileroot' }, $file ))
83 # Create a File::UseList object and load the list
85 my $uselist = new File
:: UseList
( listfile
=> $config ->{ 'uselist_file' },
86 lockfile
=> $config ->{ 'lock_file' },
87 timeout
=> $config ->{ 'lock_timeout' });
89 $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'})." );
92 # Create a hash with data submitted by user
93 # (the CGI and the File::UseList object will also be included)
95 my %data = ( physical
=> $physical ,
97 new_physical
=> $new_physical ,
98 new_virtual
=> $new_virtual ,
102 my $output = exec_command
( $command , \
%data , $config ); # Execute the command...
104 $uselist -> unlock ; # ... unlock the list with files in use...
105 print $ $output ; # ... and print the output of the command
109 abort
( $config ->{ 'err_above_root' });
114 abort
( "File/directory does not exist." );
patrick-canterino.de