#!/usr/local/bin/perl # # FileMan Version 1.01 # # A Perl file management script to allow file and directory administration # via a web browser. # # COPYRIGHT NOTICE: # # Copyright 1998 Gossamer Threads Inc. All Rights Reserved. # # This program is being distributed as shareware. It may be used and # modified free of charge for personal, academic or non-profit # use, so long as this copyright notice and the header above remain intact. # Any commercial use should be registered. By using this program # you agree to indemnify Gossamer Threads Inc. from any liability. # # Selling the code for this program without prior written consent is # expressly forbidden. Obtain permission before redistributing this # program over the Internet or in any other medium. In all cases # copyright and header must remain intact. # # Contact Information: # # Authors: Alex Krohn, and Patrick Krohn # Email: alex@gossamer-threads.com or patrick@gossamer-threads.com # # For registration information, visit our website at: # http://www.gossamer-threads.com/scripts/register # ========================================================================== # Required Libraries # -------------------------------------------------------- # use strict; # File uploads don't work with use strict in place, although script compiles with use strict. use vars qw(%config %icons $in); use CGI qw(:cgi); $in = new CGI; # Configuartion # -------------------------------------------------------- %config = ( root_dir => "/usr/local/www/virtual/spooker1/fileman-panel/fileman-data", logfile => "/usr/local/www/virtual/spooker1/fileman-panel/filemanth/fileman.log", password_dir => "/usr/local/www/virtual/spooker1/fileman-panel/filemanth/pass", root_url => "http://www.yoyoo.com/fileman-panel/fileman-data", script_url => "http://www.yoyoo.com/fileman-panel/filemanth/fileman.cgi", icondir_url => 'http://www.yoyoo.com/fileman-panel/fileman/icons', use_flock => 1, allowed_space => 5000, max_upload => 75, show_size => 1, show_date => 1, show_perm => 1, show_icon => 1, show_pass => 1, version => '1.0' ); %icons = ( 'gif jpg jpeg bmp' => 'image2.gif', 'txt' => 'quill.gif', 'cgi pl' => 'script.gif', 'zip gz tar' => 'uuencoded.gif', 'htm html shtm shtml' => 'world1.gif', 'wav au mid mod' => 'sound1.gif', folder => 'folder.gif', parent => 'back.gif', unknown => 'unknown.gif' ); # -------------------------------------------------------- # -------------------------------------------------------- # Run the program and trap fatal errors. eval { &main; }; if ($@) { &cgierr ("Fatal Error: $@"); } # -------------------------------------------------------- sub main { # ========================================================================================== # 1. Get the form input, and print the HTTP headers. # $|++; # Flush Output print $in->header('text/html'); my ($working_dir) = $in->param('wd'); # Our current working directory. my ($filename) = $in->param('fn'); # Filename to edit, delete, etc. my ($name) = $in->param('name'); # Org. filename to rename. my ($newname) = $in->param('newname'); # New filename in rename. my ($directory) = $in->param('dir'); # Directory to make/delete/change to. my ($newperm) = $in->param('newperm'); # New permissions to set. my ($action) = $in->param('action'); # Action to take. my ($user) = $in->param('user'); # Username to add to password list. my ($pass) = $in->param('pass'); # Password to add to password list. # 2. Validate the form input. This makes sure any passed in information is valid. After this # the information is assumed safe. my ($error); ($working_dir, $error) = &is_valid_dir ($working_dir); $error and &user_error ("Invalid Directory: '$working_dir'. Reason: $error", "$config{'root_dir'}/$working_dir"); ($filename, $error) = &is_valid_file ($filename); $error and &user_error ("Invalid Filename: '$filename'. Reason: $error", "$config{'root_dir'}/$working_dir"); ($name, $error) = &is_valid_file ($name); $error and &user_error ("Invalid Filename: '$name'. Reason: $error", "$config{'root_dir'}/$working_dir"); ($newname, $error) = &is_valid_file ($newname); $error and &user_error ("Invalid Filename: '$newname'. Reason: $error", "$config{'root_dir'}/$working_dir"); ($newperm, $error) = &is_valid_perm ($newperm); $error and &user_error ("Invalid Permissions: '$newperm'. Reason: $error", "$config{'root_dir'}/$working_dir"); ($user, $error) = &is_valid_user ($user); $error and &user_error ("Invalid Username: '$user'. Reason: $!", "$config{'root_dir'}/$working_dir"); ($pass, $error) = &is_valid_user ($pass); $error and &user_error ("Invalid Password: '$pass'. Reason: $!", "$config{'root_dir'}/$working_dir"); # New directory name is special. It has to pass both a filename, and directory test. ($directory, $error) = &is_valid_dir ($directory); $error and &user_error ("Invalid Directory: '$directory'. Reason: $error", "$config{'root_dir'}/$working_dir"); ($directory, $error) = &is_valid_file ($directory); $error and &user_error ("Invalid Directory: '$directory'. Reason: $error", "$config{'root_dir'}/$working_dir"); # 3. Set the current working directory, and current working url. my ($dir, $url); if ($working_dir) { $dir = "$config{'root_dir'}/$working_dir"; $url = "$config{'root_url'}/$working_dir"; } else { $dir = $config{'root_dir'}; $url = $config{'root_url'}; } # 4. Print HTML intro. # Javascript form validation. my $javascript = qq~ ~; # Text to be displayed if the user does not have Javascript turned on. my $nojavascript = qq~ ~; # Print the HTML Header. print qq~ Web Designer Practise Room $config{'version'} $javascript
Back Web Designer Practise Room $config{'version'} Root
~; # 5. Figure out what to do. my ($result, @disk_space); CASE: { ($action eq 'write') and do { @disk_space = &checkspace($config{'root_dir'}); if ($disk_space[0] < 50) { &delete_only_error; } else { $result = &write ($dir, $filename, $in->param('data'), $url); &list_files ($result, $working_dir, $url, @disk_space); } &log_action ($result, $dir) if ($config{'logfile'}); last CASE; }; ($action eq 'delete') and do { $result = &delete ($dir, $filename); @disk_space = &checkspace ($config{'root_dir'}); &list_files ($result, $working_dir, $url, @disk_space); &log_action ($result, $dir) if ($config{'logfile'}); last CASE; }; ($action eq 'makedir') and do { @disk_space = &checkspace($config{'root_dir'}); if ($disk_space[0] < 50) { &delete_only_error; } else { $result = &makedir ($dir, $directory); &list_files ($result, $working_dir, $url, @disk_space); &log_action ($result, $dir) if ($config{'logfile'}); } last CASE; }; ($action eq 'removedir') and do { @disk_space = &checkspace($config{'root_dir'}); $result = &removedir ($dir, $directory); &list_files ($result, $working_dir, $url, @disk_space); &log_action ($result, $dir) if ($config{'logfile'}); last CASE; }; ($action eq 'rename') and do { @disk_space = &checkspace($config{'root_dir'}); $result = &rename_file ($dir, $name, $newname); &list_files ($result, $working_dir, $url, @disk_space); &log_action ($result, $dir) if ($config{'logfile'}); last CASE; }; ($action eq 'edit') and do { @disk_space = &checkspace($config{'root_dir'}); if ($disk_space[0] < 50) { &delete_only_error; } else { &edit ($dir, $filename, $working_dir, $url); } last CASE; }; ($action eq 'upload') and do { @disk_space = &checkspace($config{'root_dir'}); if ($disk_space[0] < 50) { &delete_only_error; } else { my $file_space; ($file_space, $result) = &upload ($dir, $in->param('data'), $filename, $disk_space[0]); $disk_space[0] -= $file_space; $disk_space[2] += $file_space; &list_files ($result, $working_dir, $url, @disk_space); &log_action ($result, $dir) if ($config{'logfile'}); } last CASE; }; ($action eq 'permissions') and do { if ($config{'show_perm'}) { @disk_space = &checkspace($config{'root_dir'}); $result = &change_perm ($dir, $name, $newperm); &list_files ($result, $working_dir, $url, @disk_space); &log_action ($result, $dir) if ($config{'logfile'}); last CASE; } }; ($action eq 'protect_form') and do { if ($config{'show_pass'}) { &protect_form ($working_dir, $directory, ''); last CASE; } }; ($action eq 'add_user') and do { if ($config{'show_pass'}) { $result = &add_user ($user, $pass, $working_dir, $directory); &protect_form ($working_dir, $directory, $result); &log_action ($result, $dir) if ($config{'logfile'}); last CASE; } }; ($action eq 'remove_user') and do { if ($config{'show_pass'}) { $result = &remove_user ($user, $working_dir, $directory); &protect_form ($working_dir, $directory, $result); &log_action ($result, $dir) if ($config{'logfile'}); last CASE; } }; # Default Case do { @disk_space = &checkspace($config{'root_dir'}); print $nojavascript; &list_files ('File and Directory Listing.', $working_dir, $url, @disk_space); }; }; # 6. Wrap up and print the last of the HTML. print qq~
Present by: yoyoo.com v. $config{'version'}
© web design class room.		 Service by yoyoo.com
~; } # ========================================================================================== sub list_files { # ----------------------------------------------------- # Displays a list of files for a given directory. # my ($message, $working_dir, $url, @disk_space) = @_; my ($directory) = "$config{'root_dir'}/$working_dir"; my ($diskUsage) = "'Disk Usage:\\n\\nAllowed disk space:  $disk_space[1] kb\\nDisk space used:      $disk_space[2] kb\\n\\nDisk space free:      $disk_space[0] kb'"; # Print out table header with free disk space. print qq~

Contents of:   $url Disk usage
Action: $message
 Free space: $disk_space[0] kb

~; # Get the list of files using readdir. opendir (DIR, $directory) or &cgierr ("Can't open dir: '$directory'.\nReason: $!"); my @ls = readdir(DIR); closedir (DIR); # Then go through the results of ls and work out the files.. my (%directory, %text, %graphic); my ($temp_dir, $newdir, @nest, $fullfile, $filesize, $filedate, $fileperm, $fileicon, $file); FILE: foreach $file (@ls) { # Skip the "." entry and ".." if we are at root level. next FILE if ($file eq '.'); next FILE if (($file eq '..') and ($directory eq "$config{'root_dir'}/")); # Get the full filename, file size, file modification date and file permissions. $fullfile = "$directory/$file"; ($filesize, $filedate, $fileperm) = (stat($fullfile))[7,9,2]; $fileperm = &print_permissions ($fileperm) if ($config{'show_perm'}); $filesize = &print_filesize ($filesize) if ($config{'show_size'}); $filedate = &get_date($filedate) if ($config{'show_date'}); if (-d $fullfile ) { # Let's work out the relative path if it is a directory. if ($file eq '..') { @nest = split (/\//, $working_dir); (pop (@nest)) ? ($newdir = "$config{'script_url'}?wd=" . join ("/", @nest)) : ($newdir = "$config{'script_url'}"); } else { $working_dir ? ($temp_dir = "$working_dir%2F$file") : ($temp_dir = "$file"); $newdir = "$config{'script_url'}?wd=$temp_dir"; } $newdir = $in->escapeHTML($newdir); # .. directory if ($file eq '..') { $fileicon = "$config{'icondir_url'}/$icons{'parent'}" if ($config{'show_icon'}); $directory{$file} = qq~ \n~; $directory{$file} .= qq~ \n~ if ($config{'show_icon'}); $directory{$file} .= qq~ \n~; $directory{$file} .= qq~ \n~ if ($config{'show_perm'}); $directory{$file} .= qq~ \n~ if ($config{'show_date'}); $directory{$file} .= qq~ ~; $directory{$file} .= qq~ ~; } # Regular directory. else { $fileicon = "$config{'icondir_url'}/$icons{'folder'}" if ($config{'show_icon'});; $directory{$file} = qq~ \n~; $directory{$file} .= qq~ \n~ if ($config{'show_icon'}); $directory{$file} .= qq~ \n~; $directory{$file} .= qq~ \n~ if ($config{'show_perm'}); $directory{$file} .= qq~ \n~ if ($config{'show_date'}); $directory{$file} .= qq~ ~; $directory{$file} .= qq~ \n~; $directory{$file} .= qq~ \n~; $directory{$file} .= qq~ \n~ if ($config{'show_pass'}); $directory{$file} .= qq~ \n~; } } # Text Files. elsif (-T $fullfile) { $fileicon = &get_icon($fullfile) if ($config{'show_icon'}); $text{$file} = qq~ \n~; $text{$file} .= qq~ \n~ if ($config{'show_icon'}); $text{$file} .= qq~ \n~; $text{$file} .= qq~ \n~ if ($config{'show_perm'}); $text{$file} .= qq~ \n~ if ($config{'show_date'}); $text{$file} .= qq~ \n~ if ($config{'show_size'}); ($disk_space[0] > 50) ? ($text{$file} .= qq~ ~) : ($text{$file} .= qq~ ~); $text{$file} .= qq~ ~; } # Binary Files. else { $fileicon = &get_icon($fullfile) if ($config{'show_icon'}); $graphic{$file} = qq~ \n~; $graphic{$file} .= qq~ \n~ if ($config{'show_icon'}); $graphic{$file} .= qq~ \n~; $graphic{$file} .= qq~ \n~ if ($config{'show_perm'}); $graphic{$file} .= qq~ \n~ if ($config{'show_date'}); $graphic{$file} .= qq~ \n~ if ($config{'show_size'}); $graphic{$file} .= qq~ ~; } } foreach (sort keys %directory) { print $directory{$_}; } foreach (sort keys %text) { print $text{$_}; } foreach (sort keys %graphic) { print $graphic{$_}; } # Print the footer. if ($disk_space[0] < 50) { print qq~
$file$fileperm$filedatechdir
$file$fileperm$filedatechdirrmdirpass
$file$fileperm$filedate$filesizeedit
delete rename
$file$fileperm$filedate$filesize
 delete rename

You are running out of disk space. Please delete some files before creating new ones.

~; } else { print qq~
สร้าง html ไฟล์:
Filename:
สร้าง directory:
Name:
Upload a File:
Local filename:
Remote filename:
~; } } # End List Files Procedure. sub delete { # ----------------------------------------------------- # Begin Delete File Procedure: # my ($directory, $filename) = @_; my ($fullfile); # Check to make sure a file name was entered. (!$filename) and return "Delete File: No filename was entered!"; # Get the full path to the file. ($directory =~ m,/$,) ? ($fullfile = "$directory$filename") : ($fullfile = "$directory/$filename"); # Delete it if it exists. if (&exists($fullfile)) { unlink ($fullfile) ? return "Delete File: '$filename' was removed." : return "Delete File: '$filename' could not be deleted. Check file permissions."; } else { return "Delete File: '$filename' could not be deleted. File not found."; } } sub edit { # ----------------------------------------------------- # Begin Edit Text File Procedure: # my ($directory, $filename, $working_dir, $url) = @_; my ($lines, $fullfile, $full_url); # Check to make sure a file name was entered. (!$filename) and return "Edit File: No filename was entered!"; # Build full file name and full url. ($directory =~ m,/$,) ? ($fullfile = "$directory$filename") : ($fullfile = "$directory/$filename"); $full_url = "$url/$filename"; # Either load the contents from a file.. if (&exists($fullfile)) { open (DATA, "<$fullfile") or &cgierr ("Can't open '$fullfile'\nReason: $!"); $lines = join ("", ); $lines =~ s/<\/TEXTAREA/<\/TEXT-AREA/ig; close DATA; print qq!

ทดลองฝีกเขียนหรือแก้ไขแทก $filename ตามความต้องการ:

!; } else { # Or use the following as a template. $lines = qq~ ~; print "

นี้คือไฟล์ใหม่. ฝึกเขียนแทก HTML ด้านล่าง:

"; } # Print out the editing and saving options. print qq~

หลังจากแก้ไข editing แล้ว, เลือก "Save Document" เพื่อ save ไฟล์ $filename และกลับไปที่ main menu.

Alternate Filename:
(อย่าแตะต้อง $filename ถ้าไม่ต้องการเปลียนชื่อ แทกที่คุณเขียนด้านบนจะถูก save ไว้ในไฟล์ชื่อ $filename. Note ถ้าชื่อไฟล์นี้ซ้ำกับไฟล์ที่มีอยู่แล้ว, ไฟล์ของคุณก็จะ overwrite เขียนทับแทนที่ลงไป.)

~; } sub write { # ----------------------------------------------------- # Begin Write Text File Procedure: # my ($directory, $filename, $data, $url) = @_; my ($fullfile, $new); # Make sure a filename was passed in. (!$filename) and return "Edit File: No filename was entered!"; # Get the full path. ($directory =~ m,/$,) ? ($fullfile = "$directory$filename") : ($fullfile = "$directory/$filename"); # Check to see if this is a new or existing file. $new = 1; (&exists($fullfile)) and ($new = 0); # Fix textarea tags. $data =~ s,$fullfile") or &cgierr ("Can't open: '$fullfile'.\nReason: $!"); print FILE $data; close(FILE); if (&exists($fullfile)) { ($new eq 'yes') ? return ("Edit File: '$filename' has been created.") : return ("Edit File: '$filename' has been edited."); } else { return ("Edit File: Cannot save '$filename'. Check permissions."); } } sub upload { # ----------------------------------------------------- # Begin Upload File Procedure: my ($directory, $data, $filename, $free_space) = @_; my ($bytesread, $buffer, $fullfile, $file_size); # Make sure we have a filename to upload. (!$filename) and return (0, "Upload: No filename was entered!"); # Get the full file name. ($directory =~ m,/$,) ? ($fullfile = "$directory$filename") : ($fullfile = "$directory/$filename"); $file_size = 0; # Open the output file and save the upload. We abort if the file is # to big, or not enough free disk space. open (OUTFILE, ">$fullfile") or &cgierr ("Can't open: '$fullfile'.\nReason: $!"); binmode (OUTFILE); # For those O/S that care. while ($bytesread=read($data,$buffer,1024)) { ($fullfile =~ /cgi|pl$/) and ($buffer =~ s/\r//g); print OUTFILE $buffer; $file_size += 1024; if (($file_size / 1000) > $free_space) { close OUTFILE; unlink ($fullfile) or &cgierr ("Can't unlink: $fullfile. Reason: $!"); return (0, "Upload: Not enough free space to upload that file. Space left: $free_space kb."); } if (($file_size / 1000) > $config{'max_upload'}) { close OUTFILE; unlink ($fullfile) or &cgierr ("Can't unlink: $fullfile. Reason: $!"); return (0, "Upload: Aborted as your file is larger then the maximum uploadable file size of $config{'max_upload'} kb!"); } } close OUTFILE; &exists($fullfile) ? return (int($file_size / 1000), "Upload: '$filename' uploaded.") : return (int($file_size / 1000), "Upload: Cannot upload '$filename'. Check permissions."); } sub makedir { # ----------------------------------------------------- # Begin Make Directory Procedure: # my ($root, $new) = @_; my ($fulldir); # Make sure we have a directory name. (!$new) and return "Make Directory: You forgot to enter in a directory name!"; # Get the full path. ($root =~ m,/$,) ? ($fulldir = "$root$new") : ($fulldir = "$root/$new"); # Create the directory unless it already exists. if (&exists($fulldir)) { return "Make Directory: '$new' already exists."; } else { mkdir ($fulldir, 0755) ? return "Make Directory: '$new' directory created." : return "Make Directory: Unable to create the directory. Check permissions."; } } sub removedir { # ----------------------------------------------------- # Removes a directory. # my ($root, $new) = @_; my ($fulldir); # Make sure we have a directory name to delete. (!$new) and return "Remove Directory: No directory name was entered!"; # Get the full directory. ($root =~ m,/$,) ? ($fulldir = "$root$new") : ($fulldir = "$root/$new"); # Then remove if possible. if (!&exists($fulldir)) { return "Remove Directory: '$new' does not exists."; } else { rmdir($fulldir) ? return "Remove Directory: '$new' has been removed." : return "Remove Directory: '$new' was not removed. Check that the directory is empty."; } } sub rename_file { # ----------------------------------------------------- # Renames a file using perls rename() function. # my ($directory, $oldfile, $newfile) = @_; # Make sure we have both an old name and a new name. (!$oldfile or !$newfile) and return "Rename: Both a source and destination file must be entered!"; # Get the full path of each file. my ($full_oldfile, $full_newfile); ($directory =~ m,/$,) ? ($full_oldfile = "$directory$oldfile" and $full_newfile = "$directory$newfile") : ($full_oldfile = "$directory/$oldfile" and $full_newfile = "$directory/$newfile"); # Make sure the oldfile exists, and the new file doesn't. (&exists($full_oldfile)) or return "Rename: Old file '$oldfile' does not exist."; (&exists($full_newfile)) and return "Rename: New file '$newfile' already exists."; # Rename. rename ($full_oldfile, $full_newfile) or &cgierr("Unable to rename '$full_oldfile' to '$full_newfile'. Reason: $!"); return "Rename: '$oldfile' has been renamed '$newfile'."; } sub change_perm { # -------------------------------------------------------- # Changes the permission attributes of a file # my ($directory, $file, $newperm) = @_; my ($full_filename, $octal_perm); # Make sure we have both a filename and a permission. (!$file) and return "Change Permissions: No file entered!"; (!$newperm) and return "Change Permissions: No new permissions entered!"; # Check to make sure the file exists. $full_filename = "$directory/$file"; (&exists($full_filename)) or return "Change Permissions: '$file' does not exist."; # Permissions have to be in octal. $octal_perm = oct($newperm); chmod ($octal_perm, $full_filename) or &cgierr("Unable to change permissions for '$file' to '$newperm'. Reason: $!"); return "Change Permissions: '$file' permissions have been changed."; } sub print_permissions { # -------------------------------------------------------- # Takes permissions in octal and prints out in ls -al format. # my $octal = shift; my $string = sprintf "%lo", ($octal & 07777); my $result = ''; foreach (split(//, $string)) { if ($_ == 7) { $result .= "rwx "; } elsif ($_ == 6) { $result .= "rw- "; } elsif ($_ == 5) { $result .= "r-x "; } elsif ($_ == 4) { $result .= "r-- "; } elsif ($_ == 3) { $result .= "-wx "; } elsif ($_ == 2) { $result .= "-w- "; } elsif ($_ == 1) { $result .= "--x "; } elsif ($_ == 0) { $result .= "--- "; } else { $result .= "unkown '$_'!"; } } return $result; } sub protect_form { # -------------------------------------------------------- # Presents the users with form to protect directory. # my ($working_dir, $directory, $result) = @_; # Set the working directory and get the password file. my ($pass_file); $working_dir ? ($pass_file = "$working_dir/$directory.pass") : ($pass_file = "$directory.pass"); $pass_file =~ s,/,_,g; $pass_file = "$config{'password_dir'}/$pass_file"; # Get the user list, and print out the forms. my (@users) = &load_users ($pass_file); my ($user_list); my ($local_dir) = "$working_dir/$directory"; $local_dir =~ s,^/,,; print qq~

Password protection for $directory :

~; print qq~

Result: $result

~ if ($result); print qq~
Add a new user, name: pass:
~; if ($#users > -1) { foreach (@users) { $user_list .= qq~
"; print "
\n\nCGI ERROR\n==========================================\n";
    $error    and print "Error Message       : $error\n";
    $0        and print "Script Location     : $0\n";
    $]        and print "Perl Version        : $]\n";
    
    print "\nConfiguration\n-------------------------------------------\n";
    foreach $key (sort keys %config) {
        my $space = " " x (20 - length($key));
        print "$key$space: $config{$key}\n";
    }
    
    print "\nForm Variables\n-------------------------------------------\n";
    foreach $key (sort $in->param) {
        my $space = " " x (20 - length($key));
        print "$key$space: " . $in->param($key) . "\n";
    }
    print "\nEnvironment Variables\n-------------------------------------------\n";
    foreach $env (sort keys %ENV) {
        my $space = " " x (20 - length($env));
        print "$env$space: $ENV{$env}\n";
    }
    print "\n
"; &log_action ("CGI ERROR: $error") if (!$nolog and $config{'logfile'}); exit; }