--- /dev/null
+#!C:/Programme/Perl/bin/perl.exe -w
+
+#
+# Dev-Editor
+#
+# Dev-Editor's main program
+#
+# Author: Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-22-2003
+#
+
+use strict;
+use CGI::Carp qw(fatalsToBrowser);
+
+use lib 'modules';
+
+use CGI;
+use Command;
+use File::UseList;
+use Output;
+use Tool;
+
+our $VERSION = '0.7';
+
+### Settings ###
+
+our %config = (
+ fileroot => 'D:/Server/WWW/Root',
+ httproot => '/',
+ uselist_file => 'uselist',
+ lock_file => 'uselist.lock',
+ lock_timeout => '10'
+ );
+
+### End Settings ###
+
+# Read the most important form data
+
+my $cgi = new CGI;
+
+my $command = $cgi->param('command') || 'show';
+my $file = $cgi->param('file') || '/';
+
+# This check has to be performed first, or abs_path() will be confused
+
+if(-e clean_path($config{'fileroot'}."/".$file))
+{
+ if(my ($physical,$virtual) = check_path($config{'fileroot'},$file))
+ {
+ # Copied from old Dev-Editor (great idea)
+
+ my %dispatch = ('show' => \&exec_show,
+ 'beginedit' => \&exec_beginedit,
+ 'canceledit' => \&exec_unlock,
+ 'endedit' => \&exec_endedit,
+ # 'mkdir' => \&exec_mkdir,
+ # 'mkfile' => \&exec_mkfile,
+ 'workwithfile' => \&exec_workwithfile,
+ # 'copy' => \&exec_copy,
+ # 'rename' => \&exec_rename,
+ 'remove' => \&exec_remove,
+ 'unlock' => \&exec_unlock
+ );
+
+ # Create a File::UseList object and load the list
+
+ my $uselist = new File::UseList(listfile => $config{'uselist_file'},
+ lockfile => $config{'lock_file'},
+ timeout => $config{'lock_timeout'});
+
+ $uselist->lock or abort("Locking failed. Try it again in a moment. If the problem persists, ask someone to recreate the lockfile ($config{'lock_file'}).");
+ $uselist->load;
+
+ # Create a hash with data submitted by user
+ # (the CGI and the File::UseList objects will also be included)
+
+ my %data = (physical => $physical,
+ virtual => $virtual,
+ new_physical => '',
+ new_virtual => '',
+ uselist => $uselist,
+ cgi => $cgi);
+
+ unless($dispatch{$command})
+ {
+ $uselist->unlock;
+ abort("Unknown command: $command");
+ }
+
+ my $output = &{$dispatch{$command}}(\%data,\%config); # Execute the command...
+
+ $uselist->unlock; # ... unlock the list with used files...
+ print $$output; # ... and print the output of the command
+ }
+ else
+ {
+ abort("Accessing files and directories above the virtual root directory is forbidden.");
+ }
+}
+else
+{
+ abort("File/directory does not exist.");
+}
+
+#
+### End ###
\ No newline at end of file
--- /dev/null
+package Command;
+
+#
+# Dev-Editor - Module Command
+#
+# Execute Dev-Editor's commands
+#
+# Author: Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-22-2003
+#
+
+use strict;
+
+use vars qw(@EXPORT
+ $script);
+
+use CGI qw(header
+ redirect);
+
+use File::Access;
+use File::Copy;
+
+use HTML::Entities;
+use Output;
+use POSIX qw(strftime);
+use Tool;
+
+$script = $ENV{'SCRIPT_NAME'};
+
+### Export ###
+
+use base qw(Exporter);
+
+@EXPORT = qw(exec_show
+ exec_beginedit
+ exec_endedit
+ exec_mkfile
+ exec_mkdir
+ exec_workwithfile
+ exec_copy
+ exec_rename
+ exec_remove
+ exec_unlock);
+
+# exec_show()
+#
+# View a directory or a file
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_show($$$)
+{
+ my ($data,$config) = @_;
+ my $physical = $data->{'physical'};
+ my $virtual = $data->{'virtual'};
+ my $output;
+
+ if(-d $physical)
+ {
+ # Create directory listing
+
+ my $direntries = dir_read($physical);
+ return error("Reading of directory $virtual failed") unless($direntries);
+
+ my $files = $direntries->{'files'};
+ my $dirs = $direntries->{'dirs'};
+
+ $output .= htmlhead("Directory listing of $virtual");
+ $output .= equal_url($config->{'httproot'},$virtual);
+ $output .= "<hr>\n\n<pre>\n";
+
+ # Create the link to the upper directory
+ # (only if we are not in the root directory)
+
+ unless($virtual eq "/")
+ {
+ my $upper = $physical."/..";
+ my @stat = stat($upper);
+
+ $output .= " [SUBDIR] ";
+ $output .= strftime("%d.%m.%Y %H:%M",localtime($stat[9]));
+ $output .= " " x 10;
+ $output .= "<a href=\"$script?command=show&file=".upper_path($virtual)."\">../</a>\n";
+ }
+
+ # Get the longest file/directory name
+
+ my $max_name_len = 0;
+
+ foreach(@$dirs,@$files)
+ {
+ my $length = length($_);
+ $max_name_len = $length if($length > $max_name_len);
+ }
+
+ # Directories
+
+ foreach my $dir(@$dirs)
+ {
+ my @stat = stat($physical."/".$dir);
+
+ $output .= " ";
+ $output .= "[SUBDIR] ";
+ $output .= strftime("%d.%m.%Y %H:%M",localtime($stat[9]));
+ $output .= " " x 10;
+ $output .= "<a href=\"$script?command=show&file=$virtual$dir/\">".encode_entities($dir)."/</a>\n";
+ }
+
+ # Files
+
+ foreach my $file(@$files)
+ {
+ my @stat = stat($physical."/".$file);
+ my $virt_path = $virtual.$file;
+ my $in_use = $data->{'uselist'}->in_use($virtual.$file);
+
+ $output .= " " x (10 - length($stat[7]));
+ $output .= $stat[7];
+ $output .= " ";
+ $output .= strftime("%d.%m.%Y %H:%M",localtime($stat[9]));
+ $output .= ($in_use) ? " (IN USE) " : " " x 10;
+ $output .= encode_entities($file);
+ $output .= " " x ($max_name_len - length($file))."\t (";
+ $output .= "<a href=\"$script?command=show&file=$virt_path\">View</a> | ";
+
+ $output .= ($in_use)
+ ? '<span style="color:#C0C0C0">Edit</span>'
+ : "<a href=\"$script?command=beginedit&file=$virt_path\">Edit</a>";
+
+ $output .= " | <a href=\"$script?command=workwithfile&file=$virt_path\">Do other stuff</a>)\n";
+ }
+
+ $output .= "</pre>\n\n<hr>\n\n";
+ $output .= <<END;
+<table border="0">
+<tr>
+<td>Create new directory:</td>
+<td>$virtual <input type="text" name="newdirname"> <input type="submit" value="Create!"></td>
+</tr>
+<tr>
+<td>Create new file:</td>
+<td>$virtual <input type="text" name="newfilename"> <input type="submit" value="Create!"></td>
+</tr>
+</table>
+
+<hr>
+END
+ $output .= htmlfoot;
+ }
+ else
+ {
+ # View a file
+
+ # Check on binary files
+
+ if(-B $physical)
+ {
+ # Binary file
+
+ return error("This editor is not able to view/edit binary files.");
+ }
+ else
+ {
+ # Text file
+
+ $output = htmlhead("Contents of file $virtual");
+ $output .= equal_url($config->{'httproot'},$virtual);
+ $output .= dir_link($virtual);
+
+ $output .= '<div style="background-color:#FFFFE0;border:1px solid black;margin-top:10px;width:100%">'."\n";
+ $output .= '<pre style="color:#0000C0;">'."\n";
+ $output .= encode_entities(${file_read($physical)});
+ $output .= "\n</pre>\n</div>";
+
+ $output .= htmlfoot;
+ }
+ }
+
+ return \$output
+}
+
+# exec_beginedit
+#
+# Lock a file and display a form to edit it
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_beginedit($$)
+{
+ my ($data,$config) = @_;
+ my $physical = $data->{'physical'};
+ my $virtual = $data->{'virtual'};
+ my $uselist = $data->{'uselist'};
+
+ return error("You cannot edit directories.") if(-d $physical);
+ return error_in_use($virtual) if($uselist->in_use($virtual));
+
+ # Check on binary files
+
+ if(-B $physical)
+ {
+ # Binary file
+
+ return error("This editor is not able to view/edit binary files.");
+ }
+ else
+ {
+ # Text file
+
+ $uselist->add_file($virtual);
+ $uselist->save;
+
+ my $dir = upper_path($virtual);
+ my $content = encode_entities(${file_read($physical)});
+
+ my $output = htmlhead("Edit file $virtual");
+ $output .= equal_url($config->{'httproot'},$virtual);
+ $output .= <<END;
+<p><b style="color:#FF0000">Caution!</b> This file is locked for other users while you are editing it. To unlock it, click <i>Save and exit</i> or <i>Exit WITHOUT saving</i>. Please <b>don't</b> click the <i>Reload</i> button in your browser! This will confuse the editor.</p>
+
+<form action="$ENV{'SCRIPT_NAME'}" method="get">
+<input type="hidden" name="command" value="canceledit">
+<input type="hidden" name="file" value="$virtual">
+<p><input type="submit" value="Exit WITHOUT saving"></p>
+</form>
+
+<form action="$ENV{'SCRIPT_NAME'}" method="post">
+<input type="hidden" name="command" value="endedit">
+<input type="hidden" name="file" value="$virtual">
+
+<table width="100%" border="1">
+<tr>
+<td width="50%" align="center"><input type="checkbox" name="save_as_new_file" value="1"> Save as new file: $dir <input type=text name="new_filename" value=""></td>
+<td width="50%" align="center"><input type="checkbox" name="encode_iso" value="1"> Encode ISO-8859-1 special chars</td>
+</tr>
+<tr>
+<td align="center"><input type="reset" value="Reset form"></td>
+<td align="center"><input type="submit" value="Save and exit"></td>
+</tr>
+</table>
+
+<textarea name="filecontent" rows="25" cols="120">$content</textarea>
+</form>
+END
+
+ $output .= htmlfoot;
+
+ return \$output;
+ }
+}
+
+# exec_endedit()
+#
+# Save a file, unlock it and return to directory view
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_endedit($$)
+{
+ my ($data,$config) = @_;
+ my $physical = $data->{'physical'};
+ my $virtual = $data->{'virtual'};
+ my $content = $data->{'cgi'}->param('filecontent');
+
+ return error("You cannot edit directories.") if(-d $physical);
+
+ if($data->{'cgi'}->param('encode_iso'))
+ {
+ # Encode all ISO-8859-1 special chars
+
+ $content = encode_entities($content,"\200-\377");
+ }
+
+ if(file_save($physical,\$content))
+ {
+ # Saving of the file was successfull - so unlock it!
+
+ return exec_unlock($data,$config);
+ }
+ else
+ {
+ return error("Saving of file '$virtual' failed'");
+ }
+}
+
+# exec_mkfile()
+#
+# Create a file and return to directory view
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_mkfile($$)
+{
+ 1;
+}
+
+# exec_mkdir()
+#
+# Create a directory and return to directory view
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_mkdir($$)
+{
+ 1;
+}
+
+# exec_workwithfile()
+#
+# Display a form for renaming/copying/deleting/unlocking a file
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_workwithfile($$)
+{
+ my ($data,$config) = @_;
+ my $physical = $data->{'physical'};
+ my $virtual = $data->{'virtual'};
+ my $unused = $data->{'uselist'}->unused($virtual);
+
+ my $output = htmlhead("Work with file $virtual");
+ $output .= equal_url($config->{'httproot'},$virtual);
+ $output .= dir_link($virtual);
+ $output .= "<p><b>Note:</b> On UNIX systems, filenames are <b>case-sensitive</b>!</p>\n\n";
+
+ $output .= "<p>Someone else is currently editing this file. So not all features are available.</p>\n\n" unless($unused);
+
+ $output .= <<END;
+<hr>
+
+<h2>Copy</h2>
+
+<p>Copy file '$virtual' to: <input type="text" name="newfilename" size="50"> <input type="submit" value="Copy!"></p>
+
+<hr>
+
+END
+
+ if($unused)
+ {
+ $output .= <<END;
+<h2>Move/rename</h2>
+
+<p>Move/Rename file '$virtual' to: <input type="text" name="newfilename" size="50"> <input type="submit" value="Move/Rename!"></p>
+
+<hr>
+
+<h2>Delete</h2>
+
+<form action="$script" method="get">
+<input type="hidden" name="file" value="$virtual">
+<input type="hidden" name="command" value="remove">
+<p><input type="submit" value="Delete file '$virtual'!"></p>
+</form>
+END
+ }
+ else
+ {
+ $output .= <<END;
+<h2>Unlock file</h2>
+
+<p>Someone else is currently editing this file. At least, the file is marked so. Maybe, someone who was editing the file, has forgotten to unlock it. In this case (and <b>only</b> in this case) you can unlock the file using this button:</p>
+
+<form action="$script" method="get">
+<input type="hidden" name="file" value="$virtual">
+<input type="hidden" name="command" value="unlock">
+<p><input type="submit" value="Unlock file '$virtual'"></p>
+</form>
+END
+ }
+
+ $output .= "\n<hr>";
+ $output .= htmlfoot;
+
+ return \$output;
+}
+
+# exec_copy()
+#
+# Copy a file and return to directory view
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_copy($$)
+{
+ 1;
+}
+
+# exec_rename()
+#
+# Rename/move a file and return to directory view
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_rename($$)
+{
+ 1;
+}
+
+# exec_remove()
+#
+# Remove a file and return to directory view
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_remove($$)
+{
+ my ($data,$config) = @_;
+ my $physical = $data->{'physical'};
+ my $virtual = $data->{'virtual'};
+
+ return error_in_use($virtual) if($data->{'uselist'}->in_use($virtual));
+
+ my $dir = upper_path($virtual);
+
+ unlink($physical);
+
+ my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=$dir");
+ return \$output;
+}
+
+# exec_unlock()
+#
+# Remove a file from the list of used files and
+# return to directory view
+#
+# Params: 1. Reference to user input hash
+# 2. Reference to config hash
+#
+# Return: Output of the command (Scalar Reference)
+
+sub exec_unlock($$)
+{
+ my ($data,$config) = @_;
+ my $physical = $data->{'physical'};
+ my $virtual = $data->{'virtual'};
+ my $uselist = $data->{'uselist'};
+
+ my $dir = upper_path($virtual);
+
+ $uselist->remove_file($virtual);
+ $uselist->save;
+
+ my $output = redirect("http://$ENV{'HTTP_HOST'}$script?command=show&file=$dir");
+ return \$output;
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### End ###
\ No newline at end of file
--- /dev/null
+package File::Access;
+
+#
+# Dev-Editor - Module File::Access
+#
+# Some simple routines for doing things with files
+# with only one command
+#
+# Author: Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-20-2003
+#
+
+use strict;
+
+use vars qw(@EXPORT);
+
+use Carp qw(croak);
+use File::Spec;
+
+### Export ###
+
+use base qw(Exporter);
+
+@EXPORT = qw(dir_read
+ file_create
+ file_read
+ file_save);
+
+# dir_read()
+#
+# Collect the files and directories in a directory
+#
+# Params: Directory
+#
+# Return: Hash reference: dirs => directories
+# files => files
+
+sub dir_read($)
+{
+ my $dir = shift;
+ local *DIR;
+
+ return unless(-d $dir);
+
+ # Get all the entries in the directory
+
+ opendir(DIR,$dir) or return;
+ my @entries = readdir(DIR);
+ closedir(DIR) or return;
+
+ # Sort the entries
+
+ @entries = sort(@entries);
+
+ my @files;
+ my @dirs;
+
+ foreach my $entry(@entries)
+ {
+ next if($entry eq "." || $entry eq "..");
+
+ if(-d File::Spec->canonpath($dir."/".$entry))
+ {
+ push(@dirs,$entry);
+ }
+ else
+ {
+ push(@files,$entry);
+ }
+ }
+
+ return {dirs => \@dirs, files => \@files};
+}
+
+# file_create()
+#
+# Create a file
+#
+# Params: File to create
+#
+# Return: true on success;
+# false on error or if the file already exists
+
+sub file_create($)
+{
+ my $file = shift;
+ local *FILE;
+
+ return if(-e $file);
+
+ open(FILE,">",$file) or return;
+ close(FILE) or return;
+
+ return 1;
+}
+
+# file_read()
+#
+# Read out a file completely
+#
+# Params: File
+#
+# Return: Contents of the file (Scalar Reference)
+
+sub file_read($)
+{
+ my $file = shift;
+ local *FILE;
+
+ open(FILE,"<",$file);
+ read(FILE, my $content, -s $file);
+ close(FILE);
+
+ return \$content;
+}
+
+# file_save()
+#
+# Save a file
+#
+# Params: 1. File
+# 2. File content as Scalar Reference
+#
+# Return: Status Code (Boolean)
+
+sub file_save($$)
+{
+ my ($file,$content) = @_;
+ my $temp = $file.".temp";
+ local *FILE;
+
+ open(FILE,">",$temp) or return;
+ print FILE $$content;
+ close(FILE) or return;
+
+ rename($temp,$file) or return;
+
+ return 1;
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### End ###
\ No newline at end of file
--- /dev/null
+package File::UseList;
+
+#
+# File::UseList
+#
+# Fuehren einer Liste mit Dateien, auf die zur Zeit zugegriffen wird
+# (basiert auf Filing::UseList von Roland Bluethgen <calocybe@web.de>)
+#
+# Autor: Patrick Canterino <patshaping@gmx.net>
+# Letzte Aenderung: 20.9.2003
+#
+
+use strict;
+
+use Carp qw(croak);
+
+our $VERSION = '1.0';
+
+# new()
+#
+# Konstruktor
+#
+# Parameter: Hash: listfile => Datei mit der Liste der benutzten Dateien
+# lockfile => Lock-Datei
+# timeout => Lock-Timeout in Sekunden (Standard: 10)
+#
+# Rueckgabe: File::UseList-Objekt
+
+sub new(%)
+{
+ my ($class,%args) = @_;
+
+ # Pruefen, ob wir alle Informationen erhalten haben
+
+ croak "Missing path of list file" unless($args{'listfile'});
+ croak "Missing path of lockfile" unless($args{'lockfile'});
+ $args{'timeout'} = 10 unless($args{'timeout'}); # Standard-Timeout
+
+ my $self = \%args;
+ $self->{'files'} = [];
+
+ return bless($self,$class);
+}
+
+# lock()
+#
+# Datei mit Liste sperren
+# (Lock-Datei loeschen)
+#
+# Parameter: -keine-
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub lock
+{
+ my $self = shift;
+ my $lockfile = $self->{'lockfile'};
+ my $timeout = $self->{'timeout'};
+
+ # Versuche, einmal pro Sekunde die Datei zu loeschen
+ # bis das Timeout erreicht ist
+
+ for(my $x=$timeout;$x>=0;$x--)
+ {
+ unlink($lockfile) and return 1;
+ sleep(1);
+ }
+
+ # Timeout
+
+ return;
+}
+
+# unlock()
+#
+# Datei mit Liste freigeben
+# (Lock-Datei anlegen)
+#
+# Parameter: -keine-
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub unlock
+{
+ my $self = shift;
+ my $lockfile = $self->{'lockfile'};
+ local *LOCKFILE;
+
+ return 1 if(-f $lockfile); # Hmmm...
+
+ open(LOCKFILE,">",$lockfile) or return;
+ close(LOCKFILE) or return;
+
+ return 1;
+}
+
+# load()
+#
+# Liste mit Dateien laden
+#
+# Parameter: -keine-
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub load
+{
+ my $self = shift;
+ my $file = $self->{'listfile'};
+ local *FILE;
+
+ # Datei auslesen und zeilenweise aufteilen
+
+ open(FILE,"<".$file) or return;
+ read(FILE, my $content, -s $file);
+ close(FILE) or return;
+
+ my @files = split(/\015\012|\012|\015/,$content);
+
+ # Unbrauchbare Zeilen entfernen
+
+ for(my $x=0;$x<@files;$x++)
+ {
+ if($files[$x] eq "" || $files[$x] =~ /^\s+$/)
+ {
+ splice(@files,$x,1);
+ $x--; # <-- sehr wichtig!
+ }
+ }
+
+ $self->{'files'} = \@files;
+ return 1;
+}
+
+# save()
+#
+# Liste mit Dateien speichern
+#
+# Parameter: -keine-
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub save
+{
+ my $self = shift;
+ my $file = $self->{'listfile'};
+ my $temp = $file.".temp";
+ my $files = $self->{'files'};
+ local *FILE;
+
+ my $data = (@$files) ? join("\n",@$files)."\n" : '';
+
+ open(FILE,">",$temp) or return;
+ print FILE $data;
+ close(FILE) or return;
+
+ rename($temp,$file) and return 1;
+
+ # Mist
+
+ return;
+}
+
+# add_file()
+#
+# Datei zur Liste hinzufuegen
+#
+# Parameter: Datei
+
+sub add_file($)
+{
+ my ($self,$file) = @_;
+ my $files = $self->{'files'};
+
+ # Pruefen, ob die Datei nicht schon in der Liste vorhanden ist
+
+ return if($self->in_use($file));
+
+ push(@$files,$file);
+}
+
+# remove_file()
+#
+# Datei aus der Liste entfernen
+#
+# Parameter: Datei
+
+sub remove_file($)
+{
+ my ($self,$file) = @_;
+ my $files = $self->{'files'};
+
+ # Pruefen, ob die Datei ueberhaupt in der Liste vorhanden ist
+
+ return if($self->unused($file));
+
+ # Datei entfernen
+
+ for(my $x=0;$x<@$files;$x++)
+ {
+ if($files->[$x] eq $file)
+ {
+ splice(@$files,$x,1);
+ last;
+ }
+ }
+}
+
+# in_use()
+#
+# Pruefen, ob eine Datei in der Liste vorhanden ist
+#
+# Parameter: Zu pruefende Datei
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub in_use($)
+{
+ my ($self,$file) = @_;
+ my $files = $self->{'files'};
+
+ foreach(@$files)
+ {
+ return 1 if($_ eq $file);
+ }
+
+ return;
+}
+
+# unused()
+#
+# Pruefen, ob eine Datei nicht in der Liste vorhanden ist
+#
+# Parameter: Zu pruefende Datei
+#
+# Rueckgabe: Status-Code (Boolean)
+
+sub unused($)
+{
+ return not shift->in_use(shift);
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### Ende ###
\ No newline at end of file
--- /dev/null
+package Output;
+
+#
+# Dev-Editor - Module Output
+#
+# HTML generating routines
+#
+# Author: Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-22-2003
+#
+
+use strict;
+
+use vars qw(@EXPORT);
+
+use CGI qw(header);
+use HTML::Entities;
+use Tool;
+
+### Export ###
+
+use base qw(Exporter);
+
+@EXPORT = qw(htmlhead
+ htmlfoot
+ error
+ abort
+ error_in_use
+ equal_url
+ dir_link);
+
+# htmlhead()
+#
+# Generate the head of a HTML document
+#
+# Params: Title and heading
+#
+# Return: Head for the HTML document
+
+sub htmlhead($)
+{
+ my $title = shift;
+
+ my $html = header(-type => "text/html");
+
+ $html .= <<END;
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+"http://www.w3.org/TR/html4/loose.dtd">
+
+<html>
+<head>
+<title>$title</title>
+<meta http-equiv="content-type" content="text/html; charset=iso-8859-1">
+</head>
+<body bgcolor="#FFFFFF">
+
+<h1>$title</h1>
+
+END
+
+ return $html;
+}
+
+# htmlfoot()
+#
+# Generate the foot of a HTML document
+#
+# Params: -nothing-
+#
+# Return: Foot for the HTML document
+
+sub htmlfoot
+{
+ return "\n</body>\n</html>";
+}
+
+# error()
+#
+# Format an error message
+#
+# Params: Error message
+#
+# Return: Formatted message (Scalar Reference)
+
+sub error($)
+{
+ my $message = shift;
+
+ my $output = htmlhead("Error");
+ $output .= "<p>$message</p>";
+ $output .= htmlfoot;
+
+ return \$output;
+}
+
+# abort()
+#
+# Print and error message and exit script
+#
+# Params: Error message
+
+sub abort($)
+{
+ my $output = error(shift);
+ print $$output;
+ exit;
+}
+
+# error_in_use()
+#
+# Create a message, that a file is currently in use
+#
+# Params: File, which is in use
+#
+# Return: Formatted message (Scalar Reference)
+
+sub error_in_use($)
+{
+ my $file = encode_entities(shift);
+ my $dir = upper_path($file);
+
+ my $message = htmlhead("File in use");
+ $message .= "<p>The file '$file' is currently editet by someone else.</p>\n\n";
+ $message .= "<a href=\"$ENV{'SCRIPT_NAME'}?command=show&file=$dir\"><p>Back to $dir</a></p>";
+ $message .= htmlfoot;
+
+ return \$message;
+}
+
+# equal_url()
+#
+# Create an "equals"-link and print it out
+#
+# Params: 1. HTTP root
+# 2. Relative path
+#
+# Return: Formatted link (String)
+
+sub equal_url($$)
+{
+ my ($root,$path) = @_;
+ my $url;
+
+ $root =~ s!/$!!;
+ $path =~ s!^/!!;
+ $url = $root."/".$path;
+ $url = encode_entities($url);
+
+ return "<p>(equals <a href=\"$url\" target=\"_blank\">$url</a>)</p>\n\n";
+}
+
+# dir_link()
+#
+# Create the link to the directory of a file and
+# print it out
+#
+# Params: File
+#
+# Return: Formatted link (String)
+
+sub dir_link($)
+{
+ my $dir = upper_path(shift);
+ $dir = encode_entities($dir);
+
+ return "<p><a href=\"$ENV{'SCRIPT_NAME'}?command=show&file=$dir\">Back to $dir</a></p>\n\n";
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### End ###
\ No newline at end of file
--- /dev/null
+package Tool;
+
+#
+# Dev-Editor - Module Tool
+#
+# Some shared sub routines
+#
+# Author: Patrick Canterino <patshaping@gmx.net>
+# Last modified: 09-22-2003
+#
+
+use strict;
+
+use vars qw(@EXPORT);
+
+use Carp qw(croak);
+
+use Cwd qw(abs_path);
+use File::Basename;
+use File::Spec;
+
+### Export ###
+
+use base qw(Exporter);
+
+@EXPORT = qw(check_path
+ clean_path
+ filemode
+ upper_path);
+
+# check_path()
+#
+# Check, if a virtual path is above a virtual root directory
+# (currently no check if the path exists - check otherwise!)
+#
+# Params: 1. Virtual root directory
+# 2. Virtual path to check
+#
+# Return: Array with the physical and the cleaned virtual path;
+# false, if the submitted path is above the root directory
+
+sub check_path($$)
+{
+ my ($root,$path) = @_;
+
+ # Clean root path
+
+ $root = abs_path($root);
+ $root = File::Spec->canonpath($root);
+
+ $path =~ s!^/{1}!!;
+ $path = $root."/".$path;
+
+ unless(-d $path)
+ {
+ # The path points to a file
+ # We have to extract the directory name and create the absolute path
+
+ my @pathinfo = fileparse($path);
+
+ # This is only to avoid errors
+
+ my $basename = $pathinfo[0] || '';
+ my $dir = $pathinfo[1] || '';
+ my $ext = $pathinfo[2] || '';
+
+ $dir = abs_path($dir);
+
+ $path = $dir."/".$basename.$ext;
+ }
+ else
+ {
+ $path = abs_path($path);
+ }
+
+ $path = File::Spec->canonpath($path);
+
+ # Check if the path is above the root directory
+
+ return if(index($path,$root) == -1);
+
+ # Create short path name
+
+ my $short_path = substr($path,length($root));
+ $short_path =~ tr!\\!\/!;
+ $short_path = "/".$short_path unless($short_path =~ m!^/!);
+ $short_path = $short_path."/" if($short_path !~ m!/$! && -d $path);
+
+ return ($path,$short_path);
+}
+
+# clean_path()
+#
+# Clean up a path logically and replace backslashes with
+# normal slashes
+#
+# Params: Path
+#
+# Return: Cleaned path
+
+sub clean_path($)
+{
+ my $path = shift;
+ $path = File::Spec->canonpath($path);
+ $path =~ tr!\\!/!;
+
+ return $path;
+}
+
+# filemode()
+#
+# Creates a readable string of a UNIX filemode number
+# (copied from Tool.pm of Dev-Editor 0.1.4)
+#
+# Params: Filemode as number
+#
+# Return: Filemode as readable string
+
+sub filemode($)
+{
+ my ($modestring, $ur, $uw, $ux, $gr, $gw, $gx, $or, $ow, $ox);
+ my $mode = shift;
+
+ $ur = ($mode & 0400) ? "r" : "-"; # User Read
+ $uw = ($mode & 0200) ? "w" : "-"; # User Write
+ $ux = ($mode & 0100) ? "x" : "-"; # User eXecute
+ $gr = ($mode & 0040) ? "r" : "-"; # Group Read
+ $gw = ($mode & 0020) ? "w" : "-"; # Group Write
+ $gx = ($mode & 0010) ? "x" : "-"; # Group eXecute
+ $or = ($mode & 0004) ? "r" : "-"; # Other Read
+ $ow = ($mode & 0002) ? "w" : "-"; # Other Write
+ $ox = ($mode & 0001) ? "x" : "-"; # Other eXecute
+
+ # build a readable mode string (rwxrwxrwx)
+ return $ur . $uw . $ux . $gr . $gw . $gx . $or . $ow . $ox;
+}
+
+# upper_path()
+#
+# Truncate a path in one of the following ways:
+#
+# - If the path points to a directory, the upper directory
+# will be returned.
+# - If the path points to a file, the directory containing
+# the file will be returned.
+#
+# Params: Path
+#
+# Return: Truncated path
+
+sub upper_path($)
+{
+ my $path = shift;
+ $path =~ tr!\\!/!;
+
+ unless($path eq "/")
+ {
+ $path = substr($path,0,-1) if($path =~ m!/$!);
+ $path = substr($path,0,rindex($path,"/"));
+ $path = $path."/";
+ }
+
+ return $path;
+}
+
+# it's true, baby ;-)
+
+1;
+
+#
+### End ###
\ No newline at end of file
git.p6c8.net / devedit.git / commitdiff