#!/usr/bin/perl BEGIN { # This logs all errors to a log file with info on what happened # to cause the script to fail. # Uncomment below to activate # use CGI::Carp qw(carpout); # open(LOG, ">FM.log"); # carpout(*LOG); # close(LOG); } # Begin Settings ___________________________________________ # Set the Root path and URL ~ no trailing forward slashes "/" $data_http = 'http://digibot.hypermart.net'; $data_path = '/data1/hypermart.net/digibot'; $title = qq~File Manager~; $btnstyle = qq~borderimage="file://rom/borders/buttonborder0.bif" text="#000080"~; $allowed_space = '51200'; # kilobytes $allowed_upload = '5000'; # kilobytes $icondir_url = '/images'; # Icon Directory URL ~ no trailing forward slashes # known file extensions and thier icon filenames %icons = ( 'htm wtv html shtm shtml' => 'text.gif', 'txt' => 'text.gif', 'gif jpg jpeg swf bmp' => 'image2.gif', 'rmf ram wav au mid mod' => 'sound2.gif', 'cgi pl' => 'p.gif', 'zip gz tar' => 'compressed.gif', 'readme' => 'alert.red.gif', 'htaccess htpasswd' => 'alert.red.gif', 'folder' => 'folder.gif', 'parent' => 'back.gif', 'other' => 'generic.gif', 'unknown' => 'unknown.gif' ); $cgi_url = $ENV{'SCRIPT_URL'}; # End Settings _____________________________________________ $core_data_http = $data_http; $core_data_path = $data_path; # Print the HTML header which goes on every page: sub start_html { print "Content-type: text/html\n\n"; print qq~ $title
$title
New File New Directory Root Directory Site Manager Unzipper
!-- Javascript Error! Reload Page!
--> $core_data_http
~; } # Finished printing the HTML header. # parse input read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); if ($ENV{'QUERY_STRING'}) {$buffer = "$buffer\&$ENV{'QUERY_STRING'}"; } @pairs = split(/&/,$buffer); foreach $pair (@pairs) { ($name,$value) = split(/=/,$pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; if ($name eq 'dir_names') { push(@dir_names, $value); } # get marked directories if ($name eq 'file_names') { push(@file_names, $value); } # get marked files $FORM{$name} = $value; } # Check for allowed disk space $du = `du $core_data_path`; $du =~ s/\n/ /g; @terms = split(/\s+/,$du); $used_space = $terms[-2] / 2; $free_space = $allowed_space - $used_space; $allowed_upload = $free_space if ($free_space <= $allowed_upload); $delete_only = 'true' if ($free_space < 30); if ($delete_only eq 'true') { $disabled = "disabled"; $readonly = "readonly"; } if ($FORM{'dirname'}) { $dirname = $FORM{'dirname'}; $data_path = "$data_path/$dirname"; $data_http = "$data_http/$dirname"; $cgi = "$cgi_url?dirname=$dirname"; $working_dir = "$dirname/"; } else { $cgi = "$cgi_url?"; } &start_html; print qq~
Free Space: $free_space kb

~; # Begin Select Action $action = $FORM{'action'}; if ($action) { if (!-e $data_path) { &report("$dirname does not exist!"); } elsif ($action eq 'Delete') { &Confirm_Delete; } elsif ($action eq 'Confirm Delete') { &Delete; &list_files; } elsif ($action eq 'confirm_removedir') { &confirm_removedir; } elsif ($action eq 'removedir') { &removedir; &list_files; } elsif ($action eq 'rename') { &rename; &list_files; } elsif ($action eq 'chmod') { &chmod; &list_files; } elsif ($action eq 'abort') { &report("Action Aborted! File and Directory List."); &list_files; } # If the user has gotten this far into the if/else maze, they are trying to create # or edit a file. First we check to make sure they have permission to do so: elsif ($delete_only eq 'true') { &report('This action was aborted because your disk space allotment is full or near full (less than thirty kilobytes).'); $list_files } # If they pass this flag, then they can continue with the action elsif ($action eq 'edit') { &edit; } elsif ($action eq 'write') { &write; &list_files; } elsif ($action eq 'Copy') { &confirm_copy; } elsif ($action eq 'Confirm Copy') { © &list_files; } elsif ($action eq 'upload') { &upload; &list_files; } elsif ($action eq 'makedir') { &makedir; &list_files; } } else { # no action specified if (!-e $data_path) { &report("$dirname does not exist!"); } else { &report("File and Directory List."); &list_files; } } &end_html; # End Select Action # __________________________________________________________ # Begin Footer: sub end_html { print qq~
<noembed><noframes></body></html>~; } # End Footer. # Begin Check File Extension sub Check_Ext { $ext_file = $_[0]; @ext_parts = split(/\./, $ext_file); return($ext_parts[-1]); } # End Check File Extension # Begin List Files Procedure: sub list_files { chdir($data_path); # Get Directory Sizes $du = `du`; @pairs = split(/\n/,$du); foreach $pair (@pairs) { @terms = split(/\s+/, $pair); $size = $terms[0] / 2; @parts = split(/\.\//, $terms[1]); if ($size < 1000) { $SIZE{$parts[1]} = $size . " kb"; } else { $SIZE{$parts[1]} = sprintf("%.2f", $size / 1000) . " megs"; } } $ls = `ls -a`; @ls = split(/\s+/,$ls); print qq~<form method=post action="$cgi"><table width=100% border=0>~; foreach $temp_dir (sort @ls) { # show all directories if (-d $temp_dir && $temp_dir ne '.') { $permissions = &GetStats($temp_dir, 'perms'); $permissions2 = &GetStats($temp_dir, 'perms2'); $LModTime = &GetStats($temp_dir, 'modtime'); $LastMod = &FormatTime($LModTime); if ($temp_dir eq '..') { # Up One Directory if ($data_http ne $core_data_http) { # only show previous for sub directories @DirParts = split(/\//, $working_dir); pop(@DirParts); $last_part = pop(@DirParts); $prev_dir = ""; foreach $part (@DirParts) { $prev_dir .= "$part/"; } $prev_dir .= $last_part; print qq~<tr> <td width=5% align=center><a href="$cgi_url?dirname=$prev_dir"><img src="$icondir_url/$icons{'parent'}"></a></td> <td width=5%>&nbsp;<!-- checkbox disabled --></td> <td colspan=5><a href="$cgi_url?dirname=$prev_dir"> <font size=2>.. Up One Directory</font></a></td></tr>~; } } else { # sub-directories print qq~<tr><td width=5% align=center><a href="$cgi_url?dirname=$working_dir$temp_dir"><img src="$icondir_url/$icons{'folder'}"></a></td> <td width=5%><input type=checkbox name="dir_names" value="$temp_dir"></td> <td><a href="$data_http/$temp_dir" onMouseover="status='Modified: $LastMod'" onMouseout="status=''"> <font size=3>$temp_dir</font></a></td> <td width=6%><tt><a href="javascript:chmod('$temp_dir', '$permissions2')"> <font size=1 color=000000>$permissions</font></a></tt></td> <td width=15%><tt><font size=1>$SIZE{$temp_dir}</font></tt></td> <td width=13%><a href="$cgi&action=confirm_removedir&directory=$temp_dir"> <font color=900000 size=2>Remove</font></a></td> <td width=13%><a href="javascript:rename('$temp_dir')"> <font color=#600060 size=2>Rename</font></a></td></tr>~; } } } foreach $temp_file (sort @ls) { # show all non-directories if (!-d $temp_file) { $permissions = &GetStats($temp_file, 'perms'); $permissions2 = &GetStats($temp_file, 'perms2'); $LModTime = &GetStats($temp_file, 'modtime'); $LastMod = &FormatTime($LModTime); $size = (-s $temp_file); if ($size > 1000000) { $size = sprintf("%.2f", $size / 1000000) . " megs"; } elsif ($size > 1000) { $size = sprintf("%.1f", $size / 1000) . " kb"; } else { $size .= " bytes"; } $Ext = &Check_Ext($temp_file); $no_ext = ''; if ($#ext_parts +1 < 2) { $no_ext = 'yes'; } # select file type icon $icon = ''; foreach $key (keys %icons) { @exts = split(/ /, $key); foreach $known_ext (@exts) { if ($Ext =~ /$known_ext/i) { $icon = $icons{$key}; } elsif (!$icon && $no_ext) { $icon = $icons{'unknown'}; } elsif (!$icon) { $icon = $icons{'other'}; } } } $icon_url = "$icondir_url/$icon"; print qq~<tr> <td width=5% align=center><a href="$data_http/$temp_file"><img src="$icon_url"></a></td> <td width=5%><input type=checkbox name="file_names" value="$temp_file"></td> <td><a href="$data_http/$temp_file" onMouseover="status='Modified: $LastMod'" onMouseout="status=''"> <font size=3>$temp_file</font></a></td> <td width=6%><tt><a href="javascript:chmod('$temp_file', '$permissions2')"> <font color=000000 size=1>$permissions</font></a></tt></td> <td width=15%><tt><font size=1>$size</font></tt></td> <td width=13%> <a href="javascript:rename('$temp_file')"> <font color=#600060 size=2>Rename</font></a></td> <td width=13%>~; if (-T $temp_file) { # text file options print qq~<a href="$cgi&action=edit&filename=$temp_file" $disabled> <font color=#008555 size=2>Edit</font></a>~; } elsif ($Ext =~ /zip/i) { print qq~<font color=#e07000 size=2>Unzip</font>~; } else { print qq~&nbsp;~; } print qq~</td></tr>~; } } print qq~</table> <p> <hr> <p> <input type=submit name=action value="Copy" onFocus="status='Copy Marked Files and Directories.'" onBlur="status=''" width=200 $btnstyle>    <input type=submit name=action value="Delete" onFocus="status='Delete Marked Files and Empty Directories.'" onBlur="status=''" width=200 $btnstyle> </form> <br><br> <form method=post action="$cgi&action=upload" enctype="multipart/form-data"> <input type=file name="file"><br> Name: <input type=text name="filename" bgcolor=#ffffff text=000080 autoactivate> <input type=submit value="Upload Vidcap" $btnstyle></form>~; } # End List Files Procedure. # Begin Edit Text File Procedure: sub edit { $filename = $FORM{'filename'}; $edit_file = "$data_path/$filename"; $report = &checkname($filename); if ($report) { &report($report); &list_files; exit; } if (-e $edit_file) { open(FILE, "$edit_file"); @LINES = <FILE>; close(FILE); } else { @LINES = ''; $new = 'yes'; } if ($new) { print "<br>This is a new file. Input your text below:<p>"; } else { # edit only text files if (-T $edit_file) { print "<br>Modify <b>$filename</b> as needed below:<p>"; } else { &report("<i>$filename</i> is not a text file, only text can be edited."); &list_files; } } print qq~<form method=post action="$cgi"> <hr><font size=2 color=navy> <textarea name="file" bgcolor=#ffffff cursor=#ff0000 rows=20 width=100% usestyle growable nohighlight border=0 autoactivate>~; foreach $LINE (@LINES) { # correct problem characters and display file contents $tamp = "amp"; $lt = "lt"; $gt = "gt"; $LINE =~ s/&/\&$tamp\;/g; $LINE =~ s/</\&$lt\;/g; $LINE =~ s/>/\&$gt\;/g; print $LINE; } print qq~</textarea></font> <hr> <p> <table width=430> <tr><td align=center> <input type=hidden name="action" value="write"> <input type=submit value="Save Document" width=200 $btnstyle> </td> <td align=center> <form method=post action="$cgi"> <input type=hidden name="action" value="abort"> <input type=submit value="Exit Without Saving" width=200 $btnstyle> </form> </table> <br><br><br> <a href="javascript:alert('Entering an alternate filename will leave $filename untouched and will place the text above into a file with the alternate name.\\n\\nNote that if a file already exists with the alternate filename, you will overwrite it completely.')"> Alternate Filename:</a> <input type=text name="filename" bgcolor=#ffffff text=000080 value="$filename" autoactivate> </form>~; } # End Edit Text File Procedure. # Begin Write Text File Procedure: sub write { $filename = $FORM{'filename'}; $report = &checkname($filename); $Ext = &Check_Ext($filename); $new_path = "$data_path/$filename"; $new_http = "$data_http/$filename"; if (!-e $new_path) { $new = 'yes';} unless ($report) { $FORM{'file'} =~ s/\cM\n/\n/g; open(FILE,">$new_path"); print FILE "$FORM{'file'}"; close(FILE); if (!$new) { # set permissions on new files if ($Ext =~ /cgi|pl/i) { $perms = "755"; } else { $perms = "644"; } `chmod $perms $new_path`; } } if ($new) { if (-e $new_path) { $report .= "<i><a href=$new_http>$filename</a></i> has been created."; } else { $report .= "<i><a href=$new_http>$filename</a></i> has <i><b>not</b><i> been created."; } } else { $report .= "<i><a href=$new_http>$filename</a></i> has been edited."; } &report($report); } # End Write Text File Procedure. # Begin Make Directory Procedure: sub makedir { $directory = $FORM{'directory'}; $new_dir = "$data_path/$directory"; $report = &checkname($directory); if (-e $new_dir) { $report .= "<i>$directory</i> already exists."; } else { unless ($report) { `mkdir $new_dir`; `chmod 777 $new_dir`; } if (-e $new_dir) { $report .= "<i>$directory</i> has been created."; } else { $report .= "<i>$directory</i> was <b><u>not</u></b> created."; } } &report($report); } # End Make Directory # Begin Copy Files and Directories sub confirm_copy { $sel_files = ''; $sel_dirs = ''; if (@file_names) { $sel_files = "files"; } if (@dir_names) { $sel_dirs = "directories"; } if (@file_names && @dir_names) { $sel_both = " and "; } if ($dirname eq '') { $stay_dir = "Root Directory"; } else { $stay_dir = $dirname; } if ($sel_files || $sel_dirs) { print qq~ <script> function selnewdir(newdir) { document.copy.new_dir.value = newdir; if (document.copy.stay.checked != true) { document.copy.dirname.value = newdir; } } function stayindir() { if (document.copy.stay.checked != true) { document.copy.dirname.value = document.copy.new_dir.value; } else { document.copy.dirname.value = "$dirname"; } } </script> <p>Copy these $sel_files$sel_both$sel_dirs from: <b>$stay_dir</b>...<p> to the directory in the text box below.<br> <form method=post action="$cgi_url" name=copy> <input type=text name="new_dir" width=300 bgcolor=#ffffff text=000080 value="$dirname" onChange="selnewdir(this.value)" autoactivate> <select text=#000080 width=200 onChange="selnewdir(this.value)"> <option value="">*Root~; &DirList; print qq~</select><p> Enter new names in the text boxes or leave them blank to keep the same name.<br> <table cellpadding=5 border=0>~; foreach $cp_dir (@dir_names) { print qq~<tr><td>$cp_dir<input type=hidden name="dir_names" value="$cp_dir"></td> <td><input type=text width=110 bgcolor=#ffffff text=000080 autoactivate name="$cp_dir"></td></tr><br>~; } foreach $cp_file (@file_names) { print qq~<tr><td>$cp_file<input type=hidden name="file_names" value="$cp_file"></td> <td><input type=text width=110 bgcolor=#ffffff text=000080 autoactivate name="$cp_file"></td></tr><br>~; } print qq~</table><p> <input type=hidden name=last_dir value="$dirname"> <input type=hidden name=dirname value="$dirname"> <input type=checkbox name=stay value=yes onClick="stayindir()"> Stay in $stay_dir after copy?<p> <input type=submit name=action value="Confirm Copy" $btnstyle></form> <form method=post action="$cgi"> <input type=hidden name="action" value="abort"> <input type=submit value="Cancel" $btnstyle></form>~; } else { &report('You must choose one or more files or directories to use copy.'); &list_files; } } sub copy { $last_dir = $FORM{'last_dir'}; $new_dir = $FORM{'new_dir'}; $copied = &checkname($new_dir); if ($last_dir eq $dirname) { $show_last_dir = ""; } elsif (!$last_dir && $dirname eq $new_dir) { $show_last_dir = "Root/"; } elsif ($dirname eq $new_dir) { $show_last_dir = "$last_dir/"; } if (!$new_dir) { $show_new_dir = "Root/"; } if ($last_dir) { $cp_dir = "$last_dir/"; } if ($new_dir) { $new_dir_path = "$core_data_path/$new_dir"; } else { $new_dir_path = $core_data_path; } if (!-e $new_dir_path) { `mkdir $new_dir_path`; `chmod 777 $new_dir`; if (-e $new_dir_path) {$copied .= "Directory: <i>$new_dir</i> has been created.<br>";} else { $copied .= "Directory: <i>$new_dir</i> was <b><u>not</u></b> created.<br>"; } } foreach $cp_file (@file_names) { $new_file = $FORM{$cp_file}; # create new file path from choices if ($new_dir && $new_file) { $new_full_name = "$new_dir/$new_file"; } elsif ($new_dir && !$new_file) { $new_full_name = "$new_dir/$cp_file"; } elsif (!$new_dir && $new_file) { $new_full_name = $new_file; } # root, new name else { $new_full_name = $cp_file; } # root, same name $copied .= &checkname($new_full_name); # display full file path only for the directory that was not listed if ($dirname eq $last_dir) { # stayed in the same directory $cp_file_name = $cp_file; if ($dirname eq $new_dir) { # copied file to current directory if ($new_file) { $new_file_name = $new_file; } else { $new_file_name = $cp_file; } } else { # copied file to different directory $new_file_name = $show_new_dir . $new_full_name; } } else { # changed to a different directory $cp_file_name = $show_last_dir . $cp_file; if ($dirname eq $new_dir) { # copied file to current directory if ($new_file) { $new_file_name = $new_file; } else { $new_file_name = $cp_file; } } else { $new_file_name = $new_full_name; } # copied file to different directory } $cp_file_path = "$core_data_path/" . $cp_dir . $cp_file; $new_file_path = "$core_data_path/$new_full_name"; if (-e $new_file_path) { $copied .= "<i>$new_file_name</i> already exists.<br>"; } else { `cp $cp_file_path $new_file_path`; if (-e $new_file_path) { $copied .= "<i>$cp_file_name</i> has been copied to <i>$new_file_name</i>.<br>"; } else { $copied .= "<i>$cp_file_name</i> has <b><u>not</u></b> been copied.<br>"; } } } &report($copied); } # End Copy Files and Directories # Begin Delete Files and Empty Directories sub Confirm_Delete { $sel_files = ''; $sel_dirs = ''; if (@file_names) { $sel_files = "files"; } if (@dir_names) { $sel_dirs = "directories"; } if (@file_names && @dir_names) { $sel_both = " and "; } print qq~<p>Are you sure you want to delete these $sel_files$sel_both$sel_dirs?<p> <form method=post action="$cgi"><table><tr><td>~; foreach $del_dir (@dir_names) { print qq~$del_dir<input type=hidden name="dir_names" value="$del_dir"><br>~; } foreach $del_file (@file_names) { print qq~$del_file<input type=hidden name="file_names" value="$del_file"><br>~; } print qq~</td></tr></table><p> <input type=submit name=action value="Confirm Delete" $btnstyle></form> <form method=post action="$cgi"> <input type=hidden name="action" value="abort"> <input type=submit value="Cancel" $btnstyle></form>~; } sub Delete { foreach $del_dir (@dir_names) { $del_dir_path = "$data_path/$del_dir"; if (-e $del_dir_path) { `rmdir $del_dir_path`; if (-e $del_dir_path) { $removed .= "<i>$del_dir</i> was <b><u>not</u></b> removed.<br>"; } else { $removed .= "<i>$del_dir</i> was removed.<br>"; } } else { $removed .= "<i>$del_dir</i> was not found.<br>"; } } foreach $del_file (@file_names) { $del_file_path = "$data_path/$del_file"; if (-e $del_file_path) { # delete files `rm $del_file_path`; if (-e $del_file_path) { $removed .= "<i>$del_file</i> was <b><u>not</u></b> removed.<br>"; } else { $removed .= "<i>$del_file</i> was removed.<br>"; } } else { $removed .= "<i>$del_file</i> was not found.<br>"; } } &report($removed); } # End Delete Files and Empty Directories # Begin Remove Directory Routines sub confirm_removedir { $remove_dir = $FORM{'directory'}; $dir_path = "$data_path/$remove_dir"; $working_path = $working_dir . $remove_dir; if (-e $dir_path) { # check if directory exists chdir($dir_path); $du = `du`; @pairs = split(/\n/, $du); $testls = `ls -a`; @testls = split(/\s+/, $testls); foreach $pair (@pairs) { @terms = split(/\s+/,$pair); @parts = split(/\.\//,$terms[1]); if ($parts[1] ne "") { push (@rmDirs, $parts[1]); } } if ($#rmDirs +1 > 0 || $#testls -1 > 0) { # show contents if any print qq~<p>Are you sure you want to delete <b>$working_path</b> and <u>everything</u> in it?<p> <table><tr><td><i><b>$working_path</b></i><br>~; $dirls = `ls -a $dir_path`; @dirls = split(/\s+/, $dirls); foreach $file (sort @dirls) { if (!-d "$dir_path/$file") { print qq~$file<br>~; } } print "<p>"; foreach $Dir (sort @rmDirs) { # show all directories and files to delete print qq~<i><b>$working_path/$Dir</b></i><br>~; $rmls = `ls -a $Dir`; @rmls = split(/\s+/, $rmls); foreach $file (sort @rmls) { if (!-d "$dir_path/$Dir/$file") { print qq~$file<br>~; } } print "<p>"; } print qq~</table><p> <form method=post action="$cgi"> <input type=hidden name=action value="removedir"> <input type=hidden name="delete_dir" value="$remove_dir"> <input type=submit value="Confirm Remove" $btnstyle> </form> <form method=post action="$cgi"> <input type=hidden name="action" value="abort"> <input type=submit value="Cancel" $btnstyle></form>~; } else { # skip to remove if no contents `rmdir $dir_path`; if (-e $dir_path) { &report("<i>$remove_dir</i> was <u><b>not</b></u> removed."); &list_files; } else { &report("<i>$remove_dir</i> was removed. It was empty."); &list_files; } } } else { &report("<i>$remove_dir</i> was not found."); &list_files; } } sub removedir { $delete_dir = $FORM{'delete_dir'}; $delete_path = "$data_path/$delete_dir"; if (-e $delete_path) { `rm -r $delete_path`; if (-e $delete_path) { &report("<i>$delete_dir</i> was <i><b>not</b></i> removed."); } else { &report("<i>$delete_dir</i> and everything in it has been removed."); } } else { &report("<i>$delete_dir</i> was not found."); } } # End Remove Directory Routine # Begin Rename Routine sub rename { $old = $FORM{'old'}; $new = $FORM{'new'}; $oldfile = "$data_path/$old"; $newfile = "$data_path/$new"; $report = &checkname($new); if (-e $oldfile) { unless ($report) { `mv $oldfile $newfile`; } if (!-e $oldfile && -e $newfile) { $report .= "<i>$old</i> has been renamed to <i>$new</i>."; } else { $report .= "<i>$old</i> has <i><b>not</b></i> been renamed."; } } else { $report .= "<i>$old</i> was not found."; } &report($report); } # End Rename Routine # Begin Chmod Routine sub chmod { $file = $FORM{'file'}; $perms = $FORM{'perms'}; $file_path = "$data_path/$file"; if (-e $file_path) { if ($perms =~ /[0-7][0-7][0-7]/) { `chmod $perms $file_path`; &report("Permissions for <i>$file</i> have been set to $perms."); } else { &report("Permissions for <i>$file</i> have <i><b>not</b></i> been set. Invalid number."); } } else { &report("<i>$file</i> was not found."); } } # End Chmod Routine # Begin Error Report for Bad File Name: sub checkname { $testname = $_[0]; $error = ''; @chars = split(//,$testname); $size = @chars; if ($size == 0) { $no_name = 'y'; $error = 'y'; } if ($testname =~ /\.\./) { $double_period = 'y'; $error = 'y'; } if ($testname =~ /\/\//) { $double_slash = 'y'; $error = 'y'; } $character = ""; foreach $char (@chars) { if (!($char =~ /[A-Z,a-z,'_',\/,\-,0-9,\.]/)) { $bad_char = 'y'; if ($character) { $character = "$character, $char"; } else { $character = $char; } $error = 'y'; } } if ($chars[0] eq '/') { $initial_slash = 'y'; $error = 'y'; } if ($error) { if ($no_name) { $err .= "No file or directory name was given."; } if ($initial_slash) { $err .= "A forward slash was used as the first character."; } if ($double_period) { $err .= "Two periods were found side by side."; } if ($double_slash) { $err .= "Two forward slashes were found side by side."; } if ($bad_char) { $err .= "The character(s) <b>$character</B> is (are) forbidden.";} return("Name Error! $err<br>"); } } # Finish Error Report for Bad File Name. # Report Action Routine sub report { $full_report = $_[0]; print qq~<table width=100%><tr><td width=20%><b>Contents of:</b></td><td><tt>~; if ($dirname) { print "$dirname"; } else { print "Root"; } print qq~</tt></td></tr><tr><td valign=top><b>Action:</b></td> <td><tt><font size=2>$full_report</font></tt></td></tr></table><hr>~; } # Begin Retrive File Statistics Routine sub GetStats { $filename = $_[0]; $type = $_[1]; if ($type eq "perms") { $mode = (stat($filename))[2]; $perms = sprintf "%3o", $mode & 07777; @groups = split(//, $perms); $rwx=''; foreach $user (@groups) { if ($user == 7) { $rwx .= "rwx<br>"; } elsif ($user == 6) { $rwx .= "rw-<br>"; } elsif ($user == 5) { $rwx .= "r-x<br>"; } elsif ($user == 4) { $rwx .= "r--<br>"; } elsif ($user == 3) { $rwx .= "-wx<br>"; } elsif ($user == 2) { $rwx .= "-w-<br>"; } elsif ($user == 1) { $rwx .= "--x<br>"; } elsif ($user == 0) { $rwx .= "---<br>"; } else { $rwx .= "???<br>"; } } $stat = $rwx; } if ($type eq "perms2") { $mode = (stat($filename))[2]; $perms = sprintf "%3o", $mode & 07777; $stat = $perms; } if ($type eq "modtime") { $stat = (stat($filename))[9]; } return $stat; } # End Retrieve File Statistics Routine sub FormatTime { $thetime = $_[0]; @dow = qw(Sun Mon Tue Wed Thu Fri Sat); @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); ($sec,$min,$hour,$day,$month,$year,$wday) = (localtime($thetime))[0,1,2,3,4,5,6]; if ($day==1 || $day==21 || $day==31) { $end="st"; } elsif ($day==2 || $day==22) { $end="nd"; } elsif ($day==3 || $day==23) { $end="rd"; } else { $end = "th"; } if ($year < 2000) { $year = $year + 1900; } $min = sprintf("%02d", $min); $sec = sprintf("%02d", $sec); $FTime = "$dow[$wday], $months[$month] $day$end, $year $hour:$min:$sec"; } sub DirList { $Root = $core_data_path; $ls = `ls -R $Root`; @pairs = split(/\n/,$ls); @Dirs = (); foreach $pair (@pairs) { if ($pair =~ /$Root/) { $pair =~ s#$Root/?(.)#$1#; chop($pair); push(@Dirs, $pair); } } foreach $Dir (sort @Dirs) { $selected = ''; if ($Dir eq $dirname) { $selected = "selected"; } print qq~<option value="$Dir" $selected>$Dir~; } } ##END