#!/usr/bin/perl # # filechucker.cgi # ###################################################################### # # DO NOT EDIT THIS FILE unless absolutely necessary; in most cases # you should be editing filechucker_prefs.cgi instead. # ###################################################################### # # This program is the copyrighted work of Encodable Industries. # Redistribution is prohibited, and copies are permitted only for # backup purposes. You are free to modify the program for your # own use, but you may not distribute any modified copies of it. # # Use of this program requires a one-time license fee. You can # obtain a license here: # # http://encodable.com/filechucker/#download # # This software comes with no warranty. The author and many other # people have found it to be useful, and it is our hope that you # find it useful as well, but it comes with no guarantees. Under # no circumstances shall Encodable Industries be held liable in # any situation arising from your use of this program. We are # generally happy to provide support to all our users, but we can # make no guarantee of support. # # For more information about this program, as well as for help # and support, please visit the following pages: # # Homepage: http://encodable.com/filechucker/ # Contact: http://encodable.com/contact/ my $version = "4.05"; $ENV{PATH} = '/bin:/usr/bin'; delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; ($ENV{DOCUMENT_ROOT}) = ($ENV{DOCUMENT_ROOT} =~ /(.*)/); # untaint. use lib './perlmodules'; #use Time::HiRes 'gettimeofday'; #my $hires_start = gettimeofday(); my (%PREF,%TEXT) = (); my $debuglog = undef; #open($debuglog, ">>fcdata/debuglog.fctemp.log") or die_nice("couldn't open debuglog: $!\n"); flock $debuglog, 2; print $debuglog "\n\n"; $| = 1; use strict; #use warnings; use Fcntl; use CGI; use POSIX; use CGI qw/:standard :param/; use File::Copy; sub printd; sub die_nice; # Set globals. TODO: some of these need to be re-scoped. my ($qs, $starttime, $total_upload_size, %temp, $num_files_in_progress_or_done, $total_file_count, $shortdatetime, $shortdatetime_forfilename, $datestring8) = (); sub print_new_upload_form() { unless(user_is_allowed_to('upload')) { exit_with_access_denied('upload'); } my $juststatus = $qs =~ /(?:^|&)juststatus(?:&|$)/ ? 1 : 0; my $hiddenstyle = qq`style="position: absolute; left: -10000px; overflow: hidden; height: 0;"`; $PREF{on_page} = $juststatus ? 'popupstatus' : 'uploader'; my @dirs = get_all_writable_directories(); exit_with_access_denied() unless @dirs; start_html_output('Upload a file', 'css', 'js'); my $numitems = $total_file_count; $numitems = 1 if $numitems > $PREF{max_files_allowed}; $numitems = $PREF{num_custom_file_elements} if $PREF{using_custom_file_elements} =~ /yes/i; if($PREF{in_reprocessing_mode}) { $numitems = 0; my @qsitems = split(/&/, $qs); foreach my $item (@qsitems) { if($item =~ /^ffs\d+=file-(.+)/) { my $filename = $1; enc_urldecode($filename); $numitems++; $PREF{reprocessing_file_names}{$numitems} = $filename; } } } # The onsubmit() in this
is only fired when someone presses Enter when a textbox is focused. The upload button has its own call to onsubmit(). # print qq`\n\n`; print qq`
$PREF{intro}
\n\n` if $PREF{intro}; print get_special_upload_note(); if($PREF{enable_old_file_count_selector} =~ /yes/i && $PREF{max_files_allowed} > 1 && $PREF{using_custom_file_elements} !~ /yes/i) { my $disabled = $PREF{in_reprocessing_mode} ? qq`disabled="disabled"` : ''; print qq`
`; print qq`
$PREF{setfilecount_title}
\n` if $PREF{setfilecount_title} && $PREF{setfilecount_title} =~ /\S/; print qq`
$PREF{number_of_files_label}   \n\n   \n
\n
\n\n\n\n`; } print qq`\n`; print qq`\n`; print $PREF{custom_form_fields_top___code}; my $top_textboxes = get_textboxes('top'); print qq`$top_textboxes\n\n\n\n` if $top_textboxes; unless($PREF{using_custom_file_elements} =~ /yes/i) { print qq`
\n` if $PREF{print_filefields_wrapper_div} =~ /yes/i; print qq`
$PREF{choosefiles_title}
\n` if $PREF{choosefiles_title} && $PREF{choosefiles_title} =~ /\S/i; my $subdir_from_url = ''; if($qs =~ /(?:^|&)path=(.+?)(?:&|$)/) { $subdir_from_url = $1; enc_urldecode($subdir_from_url); $subdir_from_url = enc_untaint($subdir_from_url, 'keep_path'); slashify($subdir_from_url); } my $tab = $PREF{print_filefields_wrapper_div} =~ /yes/i ? "\t" : ''; for(my $i=1; $i<=$numitems; $i++) { my $row = ($i % 2) ? 'odd' : 'even'; if($PREF{in_reprocessing_mode}) { print qq`$tab
`; if($i == 1 && $PREF{reprocessing_mode_file_list_message}) { my ($folder_name) = ($subdir_from_url =~ m!([^/]+)/*$!); $folder_name = '/' unless $folder_name; $PREF{reprocessing_mode_file_list_message} =~ s/%%folder_name%%/$folder_name/g; $PREF{reprocessing_mode_file_list_message} =~ s/%%num_files%%/$numitems/g; print $PREF{reprocessing_mode_file_list_message}; } print qq`\n`; my $subdir = (); if($subdir_from_url) { $subdir = $subdir_from_url; } else { $subdir = $PREF{userdir} ? qq`/$PREF{userdir_folder_name}/$PREF{userdir}/` : '/'; } print qq`\n`; } else { print qq`$tab
`; print qq`
` if $PREF{print_file_element_wrapper_div} =~ /yes/i; print qq` `; print qq`
` if $PREF{print_file_element_wrapper_div} =~ /yes/i; if($PREF{enable_subdirs} =~ /yes/i) { if($PREF{display_dropdown_box_for_subdir_selection} =~ /yes/i) { my $uploaded_files_url_path = get_uploaded_files_url_path('without_trailing_slash'); print qq`\n$tab
$TEXT{Upload_to_}
`; } else { my $subdir = ''; if($subdir_from_url) { $subdir = $subdir_from_url; } else { $subdir = $PREF{userdir} ? qq`/$PREF{userdir_folder_name}/$PREF{userdir}/` : '/'; } print qq`\n$tab`; } if($PREF{enable_manual_creation_of_new_subdirs_during_upload} =~ /yes/i && user_is_allowed_to('create_folders_during_upload')) { unless($PREF{only_allow_one_new_subdir_per_upload} =~ /yes/i && $i > 1) { my $newsubdir_instructions = $PREF{display_dropdown_box_for_subdir_selection} =~ /yes/i ? qq`\n$tab
$TEXT{will_be_created_inside___}
` : ''; print qq`\n$tab
$TEXT{New_subdirectory__Name_}
$newsubdir_instructions`; } } print qq`\n$tab`; } } my $custom_perfile_code = $PREF{custom_form_fields_perfile___code}; $custom_perfile_code =~ s/_%i/_$i/g; print $custom_perfile_code; my $perfile_textboxes = get_textboxes('perfile', $i); print $perfile_textboxes if $perfile_textboxes; print qq`
\n`; } print qq`
\n\n\n\n` if $PREF{print_filefields_wrapper_div} =~ /yes/i; if($PREF{enable_old_file_count_selector} !~ /yes/i && $PREF{max_files_allowed} > 1 && $PREF{using_custom_file_elements} !~ /yes/i && !$PREF{in_reprocessing_mode}) { print qq`\n`; } } my $bottom_textboxes = get_textboxes('bottom'); print $bottom_textboxes if $bottom_textboxes; print $PREF{custom_form_fields_bottom___code}; print qq`
$PREF{outtro}
\n\n\n\n` if $PREF{outtro}; print get_human_test_form() if ($PREF{enable_human_test} =~ /yes/i && image_humantest_possible()); print qq`
\n` if $PREF{show_upload_status_in_popup_window} =~ /yes/i; print qq` $PREF{upload_button}
$PREF{progress_bar_placeholder_message}
? $PREF{KB}/s
$TEXT{Connecting_please_wait_}
? %
 
` . ($PREF{show_progress_table_during_uploads} =~ /yes/i ? qq`
$TEXT{Files}$TEXT{Size}$TEXT{Time}
$TEXT{Total} $total_file_count ? ??:??:??
$TEXT{Completed} 0 0 00:00:00
$TEXT{Remaining} $total_file_count ? ??:??:??
` : undef) . qq` $PREF{cancelbutton}
`; print qq`
\n` if $PREF{debug}; print qq`
\n` if $PREF{clear_page_during_upload} =~ /yes/i; print qq`
\n` if $PREF{show_progress_table_during_uploads} =~ /yes/i; print qq`
\n` if $juststatus; print qq`
\n` if $PREF{show_upload_status_in_popup_window} =~ /yes/i; finish_html_output('home', 'list', 'logout', 'login'); delete_old_files(); } sub hook { my ($current_filename, $buffer, $bytes_read, $logfh) = @_; my $current_file_has_been_logged = 0; my ($progress,$currentfile,$totalfiles,$totalsize,$start_time) = (); my $serial = $PREF{serial}; my @logcontents = (); # We're still the original process that's accepting the upload, so # we don't need to ask the backend for this now, we can store it # in a hash for easier retrieval: # $progress = $PREF{uploaddata}{$serial}{progress}; $currentfile = $PREF{uploaddata}{$serial}{currentfile}; $totalfiles = $PREF{uploaddata}{$serial}{totalfiles}; $totalsize = $PREF{uploaddata}{$serial}{totalsize}; $start_time = $PREF{uploaddata}{$serial}{start_time}; # There are three possibilities here: # # 1. $current_filename has already been logged (i.e. it's in @allfiles) # and its size has either gone up, or stayed the same; # # 2. $current_filename is in @allfiles but its size appears to have gone # down, meaning the user has uploaded two files that have the same # filename, so we'll handle this with if(!$current_file_has_been_logged); # # 3. $current_filename is NOT in @allfiles, which we'll also handle with # if(!$current_filename_has_been_logged). my $new_progress = (); my (@allfiles) = split(m!///!, $progress); for(@allfiles) { if(/(.+)=(\d+)$/) { my ($file,$old_progress) = ($1,$2); if($file eq $current_filename && $bytes_read >= $old_progress) { $new_progress .= "${current_filename}=${bytes_read}"; $current_file_has_been_logged = 1; } else { $new_progress .= "${file}=${old_progress}"; } $new_progress .= "///"; } } if(!$current_file_has_been_logged) { unless(!$current_filename || $bytes_read !~ /^\d+$/) { $new_progress .= "${current_filename}=${bytes_read}"; $num_files_in_progress_or_done++; } } # Update our hash for the next time hook() is called. We'll still update # the backend below, so the client can get the info too. # $PREF{uploaddata}{$serial}{progress} = $new_progress; $PREF{uploaddata}{$serial}{currentfile} = $num_files_in_progress_or_done; $PREF{uploaddata}{$serial}{totalfiles} = $total_file_count; $PREF{uploaddata}{$serial}{totalsize} = $total_upload_size; $PREF{uploaddata}{$serial}{start_time} = $starttime; if($PREF{use_database_for_temp_data} =~ /yes/i) { sql_untaint($new_progress, $num_files_in_progress_or_done, $total_file_count, $total_upload_size, $starttime, $PREF{serial}); my $sth = $PREF{dbh}->prepare("UPDATE $PREF{table_name_for_temp_data} SET progress='$new_progress', currentfile='$num_files_in_progress_or_done', totalfiles='$total_file_count', totalsize='$total_upload_size', start_time='$starttime' WHERE serial='$PREF{serial}';"); $sth->execute or die "$0: $DBI::errstr\n"; } else { seek $logfh, 0, 0; # seek to the beginning again, before we start writing. print $logfh "${new_progress}:|:${num_files_in_progress_or_done}:|:${total_file_count}:|:${total_upload_size}:|:${starttime}:|:ppd_false\n"; # print the static info truncate $logfh, tell $logfh; # truncate the file (on the off chance that the new size is less than the old) flock $logfh, 8; # release the lock } } sub get_progress_and_size { printd(qq`starting get_progress_and_size()\n`); unless(user_is_allowed_to('upload')) { exit_with_access_denied('upload'); } my $serial = shift; $serial = enc_untaint($serial); my ($progress,$currentfile,$totalfiles,$totalprogress,$totalsize,$start_time,$elapsedtime,$ppd_status) = ('','','','','','','',''); if($PREF{using_upload_hook} =~ /yes/i) { if($PREF{use_database_for_temp_data} =~ /yes/i) { sql_untaint($serial); my $sth = $PREF{dbh}->prepare("SELECT progress,currentfile,totalfiles,totalsize,start_time FROM $PREF{table_name_for_temp_data} WHERE serial='$serial';"); $sth->execute; ($progress,$currentfile,$totalfiles,$totalsize,$start_time) = $sth->fetchrow; } else { my $logfile = "$PREF{datadir}/$serial.fctemp.log"; if(-e $logfile) { open(READLOGFILE,"<$logfile") or die "$0: couldn't open $logfile for reading: $!\n"; flock READLOGFILE, 1; seek READLOGFILE, 0, 0; my $line = ; chomp $line; close READLOGFILE or die "$0: couldn't close $logfile after reading: $!\n"; ($progress,$currentfile,$totalfiles,$totalsize,$start_time,$ppd_status) = split(/:\|:/, $line); } else { return 'ENOLOG'; } } my (@allfiles) = split(m!///!, $progress); for(@allfiles) { my ($file,$progress) = (/(.+)=(\d+)$/); $progress = 0 unless $progress; $totalprogress += $progress; } $elapsedtime = offsettime() - $start_time; } else { # If we're not using the upload hook from CGI.pm, then we can't detect # the file boundaries within the raw post data, which means we can't # display the info for files total/completed/remaining. So we just # need the totalsize, already-uploaded-size, and starttime/elapsedtime # here. if($PREF{use_database_for_temp_data} =~ /yes/i) { sql_untaint($serial); my $sth = $PREF{dbh}->prepare("SELECT progress,currentfile,totalfiles,totalsize,start_time FROM $PREF{table_name_for_temp_data} WHERE serial='$serial';"); $sth->execute; ($progress,$currentfile,$totalfiles,$totalsize,$start_time) = $sth->fetchrow; ($totalprogress) = ($progress =~ /.+=(\d+)/); } else { opendir(GETPROGRESSDIRFH, $PREF{datadir}) or die "$0: couldn't read directory $PREF{datadir}: $!\n"; my $dirh = \*GETPROGRESSDIRFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". my (@rawposts) = grep { /^$serial\.CL_\d+\.ST_\d+\.rawpost$/ } readdir($dirh); close $dirh or warn "$0: couldn't close directory $PREF{datadir}: $!\n"; #FIXME: why doesn't this close properly? my $rawpost = $rawposts[0]; return 'ENORAWPOST' unless -e "$PREF{datadir}/$rawpost"; ($totalsize,$start_time) = ($rawpost =~ /^$serial\.CL_(\d+)\.ST_(\d+)\.rawpost$/); $totalprogress = -s "$PREF{datadir}/$rawpost"; } $elapsedtime = offsettime() - $start_time; ($currentfile,$totalfiles) = (1,1); } my %fcvar = ( progress => $totalprogress, total_size => $totalsize, elapsed_time => $elapsedtime, finished_file_count => $currentfile ? $currentfile - 1 : 0, total_file_count => $totalfiles, ppd_status => $ppd_status eq 'ppd_true' ? 1 : 0, ); return \%fcvar; } sub tainted { return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 }; } sub data_exceeds_global_quota { my $datasize = shift; if($PREF{quota_for_entire_upload_directory} =~ /^\d+$/ && $PREF{quota_for_entire_upload_directory} > 0) { if( ($datasize + get_dir_size($PREF{uploaded_files_realpath})) > $PREF{quota_for_entire_upload_directory} ) { return 1; } } return 0; } sub data_exceeds_user_quota { my $datasize = shift; if($PREF{quota_for_member_userdirs} =~ /^\d+$/ && $PREF{quota_for_member_userdirs} > 0 && get_userdir() && !$PREF{admin_is_logged_in}) { if( ($datasize + get_dir_size($PREF{uploaded_files_realpath})) > $PREF{quota_for_member_userdirs} ) { return 1; } } return 0; } sub get_special_upload_note { my $note = ''; if($PREF{in_replace_mode}) { $note .= "Note: in Replace Mode.  Any file that you upload must have the exact same name as one of these files on the server:
"; my @qsitems = split(/&/, $qs); foreach my $item (@qsitems) { if($item =~ /^rfn\d+=file-(.+)/) { my $filename = $1; enc_urldecode($filename); $PREF{replacement_file_names}{$filename} = 1; $note .= "
$1"; } } } if($PREF{in_reprocessing_mode}) { $note .= "Note: in Reprocessing Mode.  Using your selected files from the server instead of uploading new files.
"; } if($PREF{in_addfile_mode}) { $note .= "Note: in AddFile Mode.  Upload your new file(s) to existing sets.
"; } if($note) { $note = qq`
$note
`; } return $note; } sub process_upload() { printd( qq`010: starting process_upload()` ); unless(user_is_allowed_to('upload')) { exit_with_access_denied('upload'); } if($PREF{urls_allowed_to_post_to_us_01}) { my $url_allowed = 0; foreach my $pref (sort keys %PREF) { if($pref =~ /urls_allowed_to_post_to_us_\d+$/) { $url_allowed = 1 if $ENV{HTTP_REFERER} =~ m!^$PREF{$pref}!i; } } die_nice("Error: posting from a non-allowed URL.") unless $url_allowed; } die_nice(qq`Error: you didn't pass the upload serial number (serial=NNNNNN...) on the URL.\n`) unless $PREF{serial}; $PREF{serial} = enc_untaint($PREF{serial}); my $serial = $PREF{serial}; $total_upload_size = $ENV{CONTENT_LENGTH}; my ($logfile,$logfh) = (); # We'll use this hash in the main/parent/original-getting-POSTed-to process, # so we never need to read from the backend, only write to it. # $PREF{uploaddata}{$serial}{progress} = 0; $PREF{uploaddata}{$serial}{currentfile} = $num_files_in_progress_or_done; $PREF{uploaddata}{$serial}{totalfiles} = $total_file_count; $PREF{uploaddata}{$serial}{totalsize} = $total_upload_size; $PREF{uploaddata}{$serial}{start_time} = $starttime; if($PREF{use_database_for_temp_data} =~ /yes/i) { sql_untaint($PREF{serial}, $num_files_in_progress_or_done, $total_file_count, $total_upload_size, $starttime); my $sth = $PREF{dbh}->prepare("INSERT INTO $PREF{table_name_for_temp_data} (serial,progress,currentfile,totalfiles,totalsize,start_time) VALUES('$PREF{serial}', '0', '$num_files_in_progress_or_done', '$total_file_count', '$total_upload_size', '$starttime');"); $sth->execute or die "$0: $DBI::errstr\n"; } else { $logfile = "$PREF{datadir}/$PREF{serial}.fctemp.log"; printd( qq`011: about to sysopen() logfile $logfile` ); sysopen(LOGFHFORTEMPDATA, $logfile, O_RDWR | O_EXCL | O_CREAT) or die "$0: couldn't create logfile $logfile for R/W: $!\n"; $logfh = \*LOGFHFORTEMPDATA; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". # RDWR=R/W, EXCL=die if already exists, CREAT=create if DNE. select((select($logfh), $| = 1)[0]); flock $logfh, 2; # Try closing it right away and re-opening it, to see if this fixes the problems # some people are having with the logfile not getting created till the upload is # complete. close $logfh or die "$0: couldn't write new (empty) file $logfile to disk: $!\n"; sysopen(LOGFHFORTEMPDATA, $logfile, O_RDWR) or die "$0: couldn't open $logfile for R/W: $!\n"; $logfh = \*LOGFHFORTEMPDATA; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". select((select($logfh), $| = 1)[0]); flock $logfh, 2; seek $logfh, 0, 0; my $firstline = "0:|:${num_files_in_progress_or_done}:|:${total_file_count}:|:${total_upload_size}:|:${starttime}:|:ppd_false"; print $logfh $firstline; truncate $logfh, tell $logfh; # unlikely but just in case. flock $logfh, 8; printd( qq`015: wrote first line to logfile` ); printd( qq`016: firstline: $firstline` ); printd( qq`017: unlocked logfile` ); } if($ENV{CONTENT_LENGTH} > $CGI::POST_MAX) { print "Content-type: text/plain\n\n"; print "ERROR: you tried to send $ENV{CONTENT_LENGTH} bytes,\nbut the current limit is $CGI::POST_MAX bytes.\nPlease go back and choose a smaller file.\n"; exit; } if(data_exceeds_global_quota($ENV{CONTENT_LENGTH})) { enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_errorpage}?error=globalquotaexceeded&size=$ENV{CONTENT_LENGTH}&limit=$PREF{quota_for_entire_upload_directory}$PREF{default_url_vars}"); } if(data_exceeds_user_quota($ENV{CONTENT_LENGTH})) { enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_errorpage}?error=userquotaexceeded&size=$ENV{CONTENT_LENGTH}&limit=$PREF{quota_for_member_userdirs}}$PREF{default_url_vars}"); } my ($query,$rawpost) = (); if($PREF{using_upload_hook} =~ /yes/i) { #my $filename = enc_untaint(param('uploadname1')); #die_nice("filename=$filename"); #if(-e "$PREF{uploaded_files_realpath}/$filename") #{ # $query = new CGI(""); # die_nice("Error: file '$filename' already exists."); #} $query = CGI->new(\&hook,$logfh); } else { # Receive the upload data manually and save it to a temporary file, # rather than using "my $query = CGI->new(\&hook,$logfh);" , so # that we can function on servers whose CGI.pm is too old to support # the upload hook functionality. We'll still use CGI.pm to parse # the post-data afterwards. # $rawpost = "$PREF{datadir}/$PREF{serial}.CL_${total_upload_size}.ST_" . (offsettime()) . ".rawpost"; $rawpost = enc_untaint($rawpost,'keep_path'); sysopen(UPLOADRAWDATAFH, $rawpost, O_RDWR | O_EXCL | O_CREAT) or die "$0: couldn't create $rawpost for R/W: $!\n"; my $upfh = \*UPLOADRAWDATAFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". flock $upfh, 2; # Try closing it right away and re-opening it, to see if this fixes the problems # some people are having with the rawpost not getting created till the upload is # complete. close $upfh or die "$0: couldn't write new (empty) file $rawpost to disk: $!\n"; sysopen(UPLOADRAWDATAFH, $rawpost, O_RDWR) or die "$0: couldn't open $rawpost for R/W: $!\n"; $upfh = \*UPLOADRAWDATAFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". flock $upfh, 2; seek $upfh, 0, 0; select((select($upfh), $| = 1)[0]); my ($bytes_uploaded_so_far, $chunk) = (0, ''); while( ($bytes_uploaded_so_far < $total_upload_size) && ($bytes_uploaded_so_far += read(STDIN, $chunk, 8192)) ) { select(undef, undef, undef, $PREF{sleep_time_during_nonhook_uploads}); # sleep for a few ms (see "perldoc -f select") print $upfh $chunk; # We don't use the logfile at all in nonhook mode, so this call is unnecessary. # TODO: maybe we should, then we wouldn't need to check for using_upload_hook # in the get_progress_and_size() sub? And then the ENORAWPOST+popup-status # issue would be resolved? #hook('dummy_filename_for_nonhook_version.foo', undef, $bytes_uploaded_so_far, $logfh); } truncate $upfh, tell $upfh; close $upfh or die "$0: couldn't write post-data to file $rawpost: $!\n"; # Re-open it on STDIN so that CGI.pm can process it. open(STDIN,"<$rawpost") or die "$0: couldn't open post-data file $rawpost on STDIN: $!\n"; flock STDIN, 1; seek STDIN, 0, 0; $query = new CGI(); } if($logfh) { flock $logfh, 2; seek $logfh, 0, 0; print $logfh "$PREF{uploaddata}{$serial}{progress}:|:$PREF{uploaddata}{$serial}{currentfile}:|:$PREF{uploaddata}{$serial}{totalfiles}:|:$PREF{uploaddata}{$serial}{totalsize}:|:$PREF{uploaddata}{$serial}{start_time}:|:ppd_true"; truncate $logfh, tell $logfh; # unlikely but just in case. flock $logfh, 8; } $PREF{uploaddata}{$serial}{end_time} = offsettime(); # For crappy hosts like GoDaddy that drop MySQL connections every 10 seconds: get_db_connection('force') if (database_required() && $PREF{reconnect_to_db_after_upload} =~ /yes/i); if($PREF{enable_human_test} =~ /yes/i && image_humantest_possible()) { my $passed_test = do_human_test(param("fcht1"), param("fcht2")); die_nice($TEXT{Error__failed_human_test__please_try_again_}) unless $passed_test; } if($PREF{enable_upload_counter_number} =~ /yes/i) { my $cfile = $PREF{datadir} . '/' . '_fc_counter_value.txt'; create_file_if_DNE($cfile,0666); open(CFILE,"+<$cfile") or die_nice("$PREF{internal_appname}: process_upload(): could not open file '$cfile' for R/W: $!\n"); flock CFILE, 2; seek CFILE, 0, 0; $PREF{upload_counter_value} = ; chomp $PREF{upload_counter_value}; unless($PREF{upload_counter_value} =~ /^\d+$/) { warn "$PREF{internal_appname}: process_upload(): invalid counter value '$PREF{upload_counter_value}'; using 1 instead.\n"; $PREF{upload_counter_value} = 1; } seek CFILE, 0, 0; print CFILE ($PREF{upload_counter_value} + 1) . "\n"; truncate CFILE, tell CFILE; close CFILE or die_nice("$PREF{internal_appname}: process_upload(): could not close file '$cfile' after R/W: $!\n"); if($PREF{pad_with_zeros_to_this_length} =~ /^\d+$/ && $PREF{pad_with_zeros_to_this_length} > 0) { while($PREF{upload_counter_value} !~ /^\d{$PREF{pad_with_zeros_to_this_length}}$/) { $PREF{upload_counter_value} = '0' . $PREF{upload_counter_value}; } } } my (%output, %textboxes, %files_left_blank_by_user, %cookies_to_set, $at_least_one_file_successfully_uploaded, %upload_info, $some_files_were_blocked, $textbox_values_for_qs) = (); my $numitems = $query->param('numitems'); my $f = $ENV{chr(72).chr(84).chr(84).chr(80)."_".chr(72).chr(79).chr(83).chr(84)}; $f =~ s/^w{3}\.//i; $f =~ s/:\d+$//i; $f =~ s/^(?:[^\.]+\.)+([^\.]+\.[^\.]+)$/$1/; if($f =~ /^([a-zA-Z0-9]).*([a-zA-Z0-9])\.([a-zA-Z]).*([a-zA-Z])$/) { unless((ord($1)==113&&ord($2)==101&&ord($3)==110&&ord($4)==116)) { print "Content-type: text/html\n\n"; print chr(93)."\n"; exit; } } printd( qq`030: numitems=$numitems` ); my $i = 1; foreach my $textbox (get_textbox_pref_keys('top', 'bottom')) { my $shortname = $PREF{"${textbox}_shortname"}; $textboxes{$textbox}{multiline} = $PREF{"${textbox}_multiline"} =~ /yes/i ? 1 : 0; $textboxes{$textbox}{name} = $PREF{$textbox} ? $PREF{$textbox} : $shortname; $textboxes{$textbox}{value} = $query->param($shortname); clean_up_text($textboxes{$textbox}{value}) if $PREF{"${textbox}_clean"} =~ /yes/i; $textboxes{$textbox}{value} =~ s/(\r\n|\n)/::NEWLINE::/g; # even for single-line input boxes, because it's possible to paste a newline into those. if( $PREF{"${textbox}_email"} =~ /yes/i ) { my $j = 1; for( split(/[,\s]+/, $query->param($shortname)) ) { $PREF{"email_notification_recipient_fromtextbox_${i}_${j}"} = $_ if $PREF{email_notifications_to_userEntered_addresses} =~ /yes/i; if($j == 1) { $PREF{first_user_entered_email_address} = $_ unless $PREF{first_user_entered_email_address}; } $j++; } } if( $PREF{"${textbox}_save"} =~ /yes/i ) { $cookies_to_set{$shortname} = $query->param($shortname); } $i++; } my $recipient_i = 0; # $num_file_elements is the total number of s, # whereas numitems is the number of file elements that the user # actually filled in. # my $num_file_elements = param('numfileelements'); $i = 0; # no "my" because we used $i above. for(my $h=1; $h<=$num_file_elements; $h++) { my $filename = $query->param("uploadname$h"); if(!$filename) { #if($at_least_one_file_successfully_uploaded) #{ # $files_left_blank_by_user{$i} = 1; # next; # they are uploading multiple files, and just left some of them blank. #} #else #{ # print "Content-type: text/plain\n\n"; # print "ERROR: the upload file-field is blank.\nEither you didn't choose a file, or there's some problem with your server.\nMaybe you need a newer version of the CGI.pm module?\nOr maybe your webhost/server doesn't allow file uploads?\n"; # exit; #} $files_left_blank_by_user{$h} = 1; next; } $i++; printd( qq`040: file $i of $numitems: $filename` ); $filename = enc_untaint($filename); unless($PREF{in_reprocessing_mode}) # if we're using files from the server, then we can't block them; they're already there, and must be OK. { if(filename_is_illegal($filename)) { $output{"filesize$i"} = $upload_info{$i}{size} = 'EILLEGALEXT'; $output{"linktofile$i"} = $upload_info{$i}{name} = $filename; $output{"linktofile_for_email$i"} = qq`"$filename": skipped because the filetype is not allowed.`; $some_files_were_blocked = 1; next; } } if($PREF{in_replace_mode}) { $PREF{overwrite_existing_files} = 'yes'; my @qsitems = split(/&/, $qs); foreach my $item (@qsitems) { if($item =~ /^rfn\d+=file-(.+)/) { my $fname = $1; enc_urldecode($fname); $PREF{replacement_file_names}{$fname} = 1; } } unless($PREF{replacement_file_names}{$filename}) { $output{"filesize$i"} = $upload_info{$i}{size} = 'ENOREPLACE'; $output{"linktofile$i"} = $upload_info{$i}{name} = $filename; $output{"linktofile_for_email$i"} = qq`"$filename": skipped because we are in Replace Mode and that file does not exist on the server.`; $some_files_were_blocked = 1; next; } } foreach my $textbox (get_textbox_pref_keys('perfile')) { my $shortname = $PREF{"${textbox}_shortname"}; $textboxes{"${textbox}_$i"}{multiline} = $PREF{"${textbox}_multiline"} =~ /yes/i ? 1 : 0; $textboxes{"${textbox}_$i"}{name} = $PREF{$textbox} ? $PREF{$textbox} : $shortname; $textboxes{"${textbox}_$i"}{value} = $query->param("${shortname}_$h"); clean_up_text($textboxes{"${textbox}_$i"}{value}) if $PREF{"${textbox}_clean"} =~ /yes/i; $textboxes{"${textbox}_$i"}{value} =~ s/(\r\n|\n)/::NEWLINE::/g; # even for single-line input boxes, because it's possible to paste a newline into those. if( $PREF{"${textbox}_email"} =~ /yes/i ) { my $j = 1; for( split(/[,\s]+/, $query->param("${shortname}_$h")) ) { $PREF{"email_notification_recipient_fromperfiletextbox_${i}_${j}"} = $_ if $PREF{email_notifications_to_userEntered_addresses} =~ /yes/i; if($j == 1) { $PREF{first_user_entered_email_address} = $_ unless $PREF{first_user_entered_email_address}; } $j++; } } if( $PREF{"${textbox}_save"} =~ /yes/i ) { $cookies_to_set{"${shortname}_$h"} = $query->param("${shortname}_$h"); } } unless($PREF{in_reprocessing_mode}) # files are already on the server. { if($PREF{reformat_filenames_for_all_uploads} =~ /[\$\%]/) { my $reformatted_filename = $PREF{reformat_filenames_for_all_uploads}; my ($original_filename, $original_ext) = ($filename =~ /(.+)\.(.+)/); $original_filename = $filename unless $original_filename; # in case the file had no extension. my $userdir = get_userdir(); interpolate_vars_from_URL_and_cookies($reformatted_filename); while($reformatted_filename =~ /(%FIELD\{(\w+)\})/g) { my ($to_replace, $shortname) = ($1, $2); my $formfield_key = get_formfield_key_from_shortname($shortname); my $replacement = exists $textboxes{$formfield_key} ? $textboxes{$formfield_key}{value} : $textboxes{"${formfield_key}_$h"}{value}; # the latter is for perfile formfields. $reformatted_filename =~ s/$to_replace/$replacement/; } $reformatted_filename =~ s/#C/$PREF{upload_counter_value}/g; $reformatted_filename =~ s/#O/$original_filename/g; $reformatted_filename =~ s/#E/$original_ext/g; $reformatted_filename =~ s/#U/$userdir/g; $reformatted_filename =~ s/#N/$i/g; while($reformatted_filename =~ /(\%[0-9A-Za-z])/g) { my $var = $1; $reformatted_filename =~ s/$var/strftime($var,localtime($PREF{uploaddata}{$serial}{end_time}))/e; } $filename = $reformatted_filename; #printd "reformatted filename: $reformatted_filename\n"; } } unless($PREF{in_reprocessing_mode}) # if we're using files from the server, then we can't affect their filenames at this point. { clean_up_filename($filename) if $PREF{clean_up_filenames} =~ /yes/i; remove_reserved_strings($filename); } my ($subdir, $num_subdir_levels, $newsubdir) = ('', 0, ''); if($PREF{serial_is_userdir} =~ /yes/i) { $subdir = $PREF{userdir_folder_name} . '/' . $PREF{userdir}; slashify($subdir); } elsif($PREF{enable_subdirs} =~ /yes/i) { $subdir = $query->param("subdir$h"); $subdir = enc_untaint($subdir, 'keep_path') if $subdir; $num_subdir_levels = 0; while($subdir =~ m!(/|\\)[^/\\]+!g) { $num_subdir_levels++; } slashify($subdir); } elsif($PREF{enable_userdirs} =~ /yes/i && $PREF{userdir}) { $subdir = $PREF{userdir_folder_name} . '/' . $PREF{userdir}; slashify($subdir); } else { $subdir = '/'; } my $finalpath_url = $PREF{uploaded_files_urlpath} . $subdir; my $finalpath_real = $PREF{uploaded_files_realpath} . $subdir; my $finalpath_local= $subdir; condense_slashes('leave_leading_UNC', $finalpath_real); condense_slashes($finalpath_url); die "Error: \$finalpath_real ($finalpath_real) does not exist...\n" unless -d $finalpath_real; die "Error: \$finalpath_real ($finalpath_real) is not writable...\n" unless -w $finalpath_real; exit_with_error("Insufficient permissions on target folder ('$finalpath_local').") unless user_has_write_access_to_path($finalpath_local); if($PREF{integrate_with_userbase} =~ /yes/i && $PREF{enable_userdirs} =~ /yes/i && $PREF{email_notifications_to_userbase_folder_owner} =~ /yes/i) { my $userdir = ''; if($PREF{userdir}) { $userdir = $PREF{userdir}; } elsif($PREF{admin_is_logged_in} && $finalpath_local =~ m!^/?$PREF{userdir_folder_name}/([^/]+)(/|$)!) { $userdir = $1; } if($userdir) { die_nice(qq`$PREF{internal_appname}: process_upload(): invalid username/userdir '$userdir' while processing \$PREF{email_notifications_to_userbase_folder_owner}.`) unless username_is_valid($userdir); ($PREF{userbase_folder_owner_email}) = enc_sql_select("SELECT email FROM `$PREF{user_table_name}` WHERE `username` = '$userdir';"); $PREF{userbase_folder_owner_email} = $userdir if ($PREF{userbase_folder_owner_email} !~ /.+\@.+\..+/ && $userdir =~ /.+\@.+\..+/); } } foreach my $emaildir (sort keys %{$PREF{email_notifications_per_folder}}) { if($subdir =~ /^$PREF{email_notifications_per_folder}{$emaildir}{folder}/i) { foreach my $recipient (split(/,/, $PREF{email_notifications_per_folder}{$emaildir}{recipients})) { $recipient_i++; $PREF{"email_notification_recipient_perfolder_${recipient_i}"} = $recipient; } } } if($PREF{enable_subdirs} =~ /yes/i && !$PREF{in_reprocessing_mode} && !$PREF{in_addfile_mode}) { if(($PREF{enable_manual_creation_of_new_subdirs_during_upload} =~ /yes/i && user_is_allowed_to('create_folders_during_upload')) || $PREF{automatic_new_subdir_name} =~ /\S/) { if($PREF{automatic_new_subdir_name} =~ /\S/) { $newsubdir = $PREF{automatic_new_subdir_name}; if($i == 1) # only do this the first time around; the PREF will be updated with the new value (when $i==1) so any subsequent passes have it. { interpolate_vars_from_URL_and_cookies($newsubdir); while($newsubdir =~ /(%FIELD\{(\w+)\})/g) { my ($to_replace, $shortname) = ($1, $2); my $formfield_key = get_formfield_key_from_shortname($shortname); my $replacement = exists $textboxes{$formfield_key} ? $textboxes{$formfield_key}{value} : $textboxes{"${formfield_key}_$h"}{value}; # the latter is for perfile formfields. $newsubdir =~ s/$to_replace/$replacement/; } $newsubdir =~ s/#C/$PREF{upload_counter_value}/g; while($newsubdir =~ /(\%[0-9A-Za-z])/g) { my $var = $1; $newsubdir =~ s/$var/strftime($var,localtime($PREF{uploaddata}{$serial}{end_time}))/e; } $PREF{automatic_new_subdir_name} = $newsubdir; } } elsif($PREF{only_allow_one_new_subdir_per_upload} =~ /yes/i && $i > 1) { $newsubdir = $query->param("newsubdir1"); } else { $newsubdir = $query->param("newsubdir$h"); } if($newsubdir && $PREF{max_num_of_subdir_levels} =~ /^\d+$/ && $num_subdir_levels < $PREF{max_num_of_subdir_levels}) { my $make_parents = ''; if($PREF{allow_multiple_levels_in_new_subdirs} =~ /yes/i) { $newsubdir = enc_untaint($newsubdir,'keep_path'); $make_parents = 'make_parents'; } else { $newsubdir = enc_untaint($newsubdir); } unless($PREF{automatic_new_subdir_name} =~ /\S/) { # Because if using a textbox value, we must clean it up earlier (during # the textbox processing) to make sure the final subdir name is the same # as the name that gets stored in the DB. # clean_up_filename($newsubdir) if $PREF{clean_up_filenames} =~ /yes/i; $newsubdir =~ s/^(.{1,$PREF{max_length_of_new_subdir_names}}).*/$1/; } remove_reserved_strings($newsubdir); $finalpath_url .= $newsubdir; $finalpath_real .= $newsubdir; $finalpath_local .= $newsubdir; # Make sure the new subdirectory doesn't already exist. # # Even for the special cases, we need to do this check when $i == 1. After that # (i.e. for any secondary/tertiary/etc files in a multi-file upload) the new # subdirectory *should* already exist, because we created it while processing # the first file in the upload. # unless( ($PREF{serialize_new_folders} =~ /no/i) || ($PREF{automatic_new_subdir_name} =~ /\S/ && $i > 1) || ($PREF{only_allow_one_new_subdir_per_upload} =~ /yes/i && $i > 1) ) { if(-d $finalpath_real) { my $rev = 1; my $rev_nice = (); my $spacer = $newsubdir =~ / / ? ' ' : '_'; my $finalpath_real_temp = $finalpath_real; while(-d $finalpath_real_temp) { $rev_nice = $rev < 10 ? "0$rev" : $rev; $finalpath_real_temp = $finalpath_real . $spacer . $rev_nice; $rev++; } $finalpath_url .= $spacer . $rev_nice; $finalpath_real .= $spacer . $rev_nice; $finalpath_local .= $spacer . $rev_nice; if($PREF{automatic_new_subdir_name} =~ /\S/) { # Update the PREF itself, since any later files in this upload session will use the value from $PREF{automatic_new_subdir_name}. # $newsubdir .= $spacer . $rev_nice; $PREF{automatic_new_subdir_name} = $newsubdir; } elsif($PREF{only_allow_one_new_subdir_per_upload} =~ /yes/i) { # Update the parameter itself, since any later files in this upload session will use the value from param("newsubdir1"). # $newsubdir .= $spacer . $rev_nice; $query->param(-name=>"newsubdir$h", -value=>$newsubdir); } } } create_dir_if_DNE($finalpath_real, $PREF{writable_dir_perms_as_octal}, $make_parents); } } } my $file_ext = (); if($filename =~ /(.+)\.(.+)$/) { ($filename,$file_ext) = ($1,$2); $file_ext = '.' . $file_ext; } else { if($PREF{allow_files_without_extensions} !~ /yes/i) { $output{"filesize$i"} = $upload_info{$i}{size} = 'EILLEGALEXT'; $output{"linktofile$i"} = $upload_info{$i}{name} = $filename; $output{"linktofile_for_email$i"} = qq`"$filename": skipped because files without extensions are not allowed.`; $some_files_were_blocked = 1; next; } } $filename .= '.' . strftime("%Y%m%d-%H%M", localtime($PREF{uploaddata}{$serial}{end_time})) if $PREF{datestamp_all_uploads} =~ /yes/i; my $fullfile = "$finalpath_real/$filename.$serial$file_ext"; my $fullfile_noserial = "$finalpath_real/$filename$file_ext"; my ($finalfile, $finalfile_local) = (); condense_slashes('leave_leading_UNC', $fullfile, $fullfile_noserial); unless($PREF{uploaded_files_dir} eq '/dev/null') { if($PREF{in_reprocessing_mode}) { $fullfile = $fullfile_noserial; exit_with_error("process_upload(): \$fullfile does not exist ('$fullfile').") unless -e $fullfile; $output{"filesize$i"} = (stat($fullfile))[7]; } else { my $data_copy_required = 1; if($PREF{move_tmpfile_instead_of_copying_contents} =~ /yes/i) { if(my $tmpfilename = $query->tmpFileName( $query->param("uploadname$h") )) { $tmpfilename = enc_untaint($tmpfilename, 'keep_path'); if(rename($tmpfilename, $fullfile)) { $data_copy_required = 0; } #printd "just did: rename($tmpfilename, $fullfile)\n\$data_copy_required: $data_copy_required\n"; } } if($data_copy_required) { my $upload_filehandle = $PREF{cgi_supports_upload_function} =~ /yes/i ? $query->upload("uploadname$h") : $query->param("uploadname$h"); open(UPLOADFILE,">$fullfile") or die "$0: couldn't create file $fullfile: $!\n"; binmode UPLOADFILE; # required on Windows for non-text files; harmless on other systems. while(<$upload_filehandle>) { print UPLOADFILE; } close UPLOADFILE or die "$0: couldn't close image $fullfile: $!\n"; } chmod 0666, $fullfile; $output{"filesize$i"} = (stat($fullfile))[7]; if($PREF{serialize_all_uploads} =~ /yes/i) { # if we're serializing all, then don't remove the serial number. $filename .= ".$serial"; } elsif( ($PREF{nice_serialization_always} =~ /yes/i) || ((-e $fullfile_noserial) && ($PREF{overwrite_existing_files} !~ /yes/i)) ) { # if the file without serial already exists and we're not overwriting # existing files, then don't remove the serial number. # # unless they want nice_serialization: # if($PREF{nice_serialization_when_file_exists} =~ /yes/i || $PREF{nice_serialization_always} =~ /yes/i) { # Serialize by adding _01, _02, etc, instead of the extremely-long $serial value. my $fullfile_nice_serial = $fullfile_noserial; my $j = 1; my ($k, $separator) = (); while(-e $fullfile_nice_serial) { $separator = $filename =~ /\s/ ? ' ' : '_'; $k = $j < 10 ? "0$j" : $j; $fullfile_nice_serial = "$finalpath_real/$filename$separator$k$file_ext"; $j++; } rename($fullfile, $fullfile_nice_serial); $filename .= "$separator$k"; } } else { # else remove the serial number. # because of the "&&" in the previous elsif(), it may be the case that # the serial-less file already exists and we DO want to overwrite it. # in that case, because rename() won't overwrite existing files on # some platforms, we'll do an unlink() first. # unlink($fullfile_noserial) if -e $fullfile_noserial; rename($fullfile, $fullfile_noserial); } } $finalfile = "$finalpath_url/$filename$file_ext"; $finalfile_local = "$finalpath_local/$filename$file_ext"; s![/\\]{2,}!/!g for ($finalfile, $finalfile_local); $upload_info{$i}{name} = "$filename$file_ext"; $upload_info{$i}{realpath} = $finalpath_real; $upload_info{$i}{urlpath} = $finalpath_url; $upload_info{$i}{localpath} = $finalpath_local; $upload_info{$i}{size} = $output{"filesize$i"}; for($upload_info{$i}{realpath}, $upload_info{$i}{urlpath}, $upload_info{$i}{localpath}) { $_ .= '/' unless m!/$!; } unless($PREF{in_replace_mode}) { # this happens multiple times, but that's OK; it returns the same thing every time. $textbox_values_for_qs = store_upload_info($i, $finalfile, $finalfile_local, $output{"filesize$i"}, $serial, \%textboxes) if ($PREF{store_upload_info_in_files} =~ /yes/i || $PREF{store_upload_info_in_database} =~ /yes/i); } } $at_least_one_file_successfully_uploaded = 1; $output{"filesize$i"} = format_filesize_nicely($output{"filesize$i"}); $output{"linktofile$i"} = show_files_as_links_on_upload_complete_page() ? qq`$filename$file_ext` : "$filename$file_ext"; $output{"linktofile_for_email$i"} = $PREF{uploaded_files_urlpath} ? qq`$filename$file_ext` : "$filename$file_ext"; $output{"fullpath_to_file$i"} = "$finalpath_real/$filename$file_ext"; # for attaching to notification emails. } unless($PREF{use_database_for_temp_data} =~ /yes/i || $PREF{use_single_log_backend} =~ /yes/i) { flock $logfh, 2; # lock the log seek $logfh, 0, 0; # seek to the beginning my $lastline = <$logfh>; chomp $lastline; printd( qq`060: logfile contents at end: $lastline` ); } unless($PREF{use_database_for_temp_data} =~ /yes/i) { close $logfh or die "$0: couldn't close $logfile after writing: $!\n"; chmod 0666, $logfile; } if($rawpost) { close STDIN or warn "$0: couldn't close STDIN (opened on file $rawpost): $!\n"; unlink $rawpost or die "$0: couldn't unlink $rawpost: $!\n"; } if($PREF{use_database_for_temp_data} =~ /yes/i && $PREF{purge_temp_data_immediately} =~ /yes/i) { sql_untaint($PREF{serial}); my $sth = $PREF{dbh}->prepare("DELETE FROM $PREF{table_name_for_temp_data} WHERE serial='$PREF{serial}';"); $sth->execute or die "$0: $DBI::errstr\n"; } unless($at_least_one_file_successfully_uploaded) { unless($PREF{in_replace_mode}) { $textbox_values_for_qs = get_textbox_values('all', undef, \%textboxes, 'text', 'show_field_keynames', '!!replace_NEWLINEs', '!!mark_headings') if ($PREF{store_upload_info_in_files} =~ /yes/i || $PREF{store_upload_info_in_database} =~ /yes/i); } } if( ( $PREF{email_notifications_to_webmaster} =~ /yes/i || $PREF{email_notifications_to_userEntered_addresses} =~ /yes/i || $PREF{email_notifications_to_userbase_loggedin_address} =~ /yes/i || $PREF{email_notifications_to_userbase_folder_owner} =~ /yes/i ) && !$PREF{in_replace_mode} && !$PREF{in_addfile_mode} ) { if($PREF{sender_email_address} eq 'user_email_address') { $PREF{sender_email_address} = $PREF{first_user_entered_email_address}; } if($PREF{email_notifications_to_userbase_loggedin_address} =~ /yes/i) { if($PREF{admin_is_logged_in}) { $PREF{email_notification_recipient__userbase_loggedin_address__webmaster} = $PREF{logged_in_email}; } else { $PREF{email_notification_recipient__userbase_loggedin_address} = $PREF{logged_in_email}; } } if($PREF{email_notifications_to_userbase_folder_owner} =~ /yes/i) { $PREF{email_notification_recipient__userbase_folder_owner} = $PREF{userbase_folder_owner_email}; } my %addresses_already_notified = (); foreach my $recipient_key (sort keys %PREF) { if($recipient_key =~ /^email_notification_recipient_/) { my $recipient = $PREF{$recipient_key}; next unless $recipient =~ /.+\@.+\..+/; next unless $PREF{sender_email_address} =~ /.+\@.+\..+/; next if $addresses_already_notified{$recipient}; my $shortdatetime_end = strftime("%a%b%d,%Y,%I:%M%P", localtime($PREF{uploaddata}{$serial}{end_time})); my ($ip,$host) = get_ip_and_host(); my $uploadsize = format_filesize_nicely($ENV{CONTENT_LENGTH}); my $userdir_for_email = get_userdir() ? get_userdir() : '(none)'; my $username_for_email = $PREF{logged_in_username} ? $PREF{logged_in_username} : '(none)'; my $email_subject = $PREF{email_subject}; my %attachments = (); my $is_webmaster_notification = 0; if($recipient_key =~ /^email_notification_recipient_\d+$/ || $recipient_key =~ /^email_notification_recipient_.+__webmaster$/) { $is_webmaster_notification = 1; } # Get textbox values based on shortnames: my %textbox_values_from_shortnames = (); foreach my $textbox (get_textbox_pref_keys('top', 'bottom')) { my $shortname = $PREF{"${textbox}_shortname"}; $textbox_values_from_shortnames{$shortname} = $textboxes{$textbox}{value}; } my $i = 0; for(my $h=1; $h<=$num_file_elements; $h++) { next if $files_left_blank_by_user{$h}; $i++; foreach my $textbox (get_textbox_pref_keys('perfile')) { my $shortname = $PREF{"${textbox}_shortname"}; $textbox_values_from_shortnames{"${shortname}_$i"} = $textboxes{"${textbox}_$i"}{value}; } if( ($PREF{attach_uploaded_files_on_webmaster_emails} =~ /yes/ && $is_webmaster_notification) || ($PREF{attach_uploaded_files_on_user_emails} =~ /yes/ && !$is_webmaster_notification) ) { if(-f $output{"fullpath_to_file$i"}) { $attachments{$i}{filename} = $output{"fullpath_to_file$i"}; $attachments{$i}{recommended_filename} = $output{"fullpath_to_file$i"}; $attachments{$i}{mimetype} = "application/octet-stream"; $attachments{$i}{'delete-after-sending'}= "no"; } else { die qq`$0: process_upload(): could not prepare attachment(s) for notification email, because the file '$output{"fullpath_to_file$i"}' does not exist.\n` if $PREF{email_failure_action} eq 'die_on_email_error'; } } } if($PREF{in_reprocessing_mode}) { if($PREF{webmaster_notification_email_subject__reprocessing} =~ /\S/ && $is_webmaster_notification) { $email_subject = $PREF{webmaster_notification_email_subject__reprocessing}; } elsif($PREF{user_notification_email_subject__reprocessing} =~ /\S/ && !$is_webmaster_notification) { $email_subject = $PREF{user_notification_email_subject__reprocessing}; } } else { if($PREF{webmaster_notification_email_subject} =~ /\S/ && $is_webmaster_notification) { $email_subject = $PREF{webmaster_notification_email_subject}; } elsif($PREF{user_notification_email_subject} =~ /\S/ && !$is_webmaster_notification) { $email_subject = $PREF{user_notification_email_subject}; } } my $message = $is_webmaster_notification ? $PREF{webmaster_notification_email_template} : $PREF{user_notification_email_template}; foreach my $templatable_item ($email_subject, $message) { interpolate_vars_from_URL_and_cookies($templatable_item); my (@to_be_replaced, @replacement) = (); while($templatable_item =~ /(%%(.+?)%%)/g) { my ($placeholder, $var_raw, $var) = ($1, $2, undef); if($var_raw =~ /^(.+?)--/) { $var = $1; } elsif($var_raw eq 'filelist') { next; } else { $var = $var_raw; } my $value = (); if($textbox_values_from_shortnames{$var}) { $value = $textbox_values_from_shortnames{$var}; } elsif($var eq 'uploader_ipaddress') { $value = $ip; } elsif($var eq 'uploader_hostname') { $value = $host; } elsif($var eq 'totalsize_bytes') { $value = $ENV{CONTENT_LENGTH}; } elsif($var eq 'totalsize_nice') { $value = $uploadsize; } elsif($var eq 'userdir') { $value = $userdir_for_email; } elsif($var eq 'username') { $value = $username_for_email; } elsif($var eq 'startetime') { $value = $PREF{uploaddata}{$serial}{start_time} } elsif($var eq 'starttime_nice') { $value = $shortdatetime; } # $shortdatetime is an FC global. elsif($var eq 'endetime') { $value = $PREF{uploaddata}{$serial}{end_time}; } elsif($var eq 'endtime_nice') { $value = $shortdatetime_end; } elsif($var eq 'finalpath_local') { $value = $upload_info{1}{localpath} } elsif($var eq 'counternum') { $value = $PREF{upload_counter_value}; } elsif($var =~ /^ub_var_(.+)/) { my $ubvar = $1; sql_untaint($ubvar); $value = enc_sql_select("SELECT `$ubvar` FROM `$PREF{user_table_name}` WHERE `id` = '$PREF{logged_in_userid}'"); } if($var_raw =~ /--date--(.+?)(--|$)/) { my $format = $1; $format =~ s/#/%/g; $value = strftime($format, localtime($value)); } if($var_raw =~ /--urlencode(--|$)/) { enc_urlencode($value); } if($var_raw =~ /--winslashes(--|$)/) { $value =~ s!/!\\!g; } push @to_be_replaced, $placeholder; push @replacement, $value; } my $k = 0; foreach my $string (@to_be_replaced) { $templatable_item =~ s/$string/$replacement[$k]/; $k++; } } my $i = 0; my @files = (); for(my $h=1; $h<=$num_file_elements; $h++) { next if $files_left_blank_by_user{$h}; $i++; my $file = $is_webmaster_notification ? $PREF{webmaster_notification_email_filelist_template} : $PREF{user_notification_email_filelist_template}; my $href = get_download_link($upload_info{$i}{localpath}, $upload_info{$i}{name}); $href = $PREF{protoprefix} . $ENV{HTTP_HOST} . $href unless $href =~ m!^https?//!; my $nicesize = format_filesize_nicely($upload_info{$i}{size}); $file =~ s!%%filename%%!$upload_info{$i}{name}!g; $file =~ s!%%realpath%%!$upload_info{$i}{realpath}!g; $file =~ s!%%urlpath%%!$upload_info{$i}{urlpath}!g; $file =~ s!%%localpath%%!$upload_info{$i}{localpath}!g; $file =~ s!%%filesize%%!$nicesize!g; $file =~ s!%%linktofile%%!$href!g; $file =~ s!%%filenum%%!$i!g; $file =~ s!%%filecount%%!$numitems!g; $file =~ s!%%(\w+)%%!$textbox_values_from_shortnames{"${1}_$i"}!g; push @files, $file; } my $files = join '', @files; $message =~ s/%%filelist%%/$files/; my $serial_is_userdir_info = ''; if($PREF{serial_is_userdir} =~ /yes/i && !$PREF{admin_is_logged_in}) { if($PREF{email_type} =~ /html/i) { $serial_is_userdir_info .= qq`



To access or reuse this uploads folder, go to:

$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_filelist}?action=listfiles&userdir=` . get_userdir() . qq`

\n`; $serial_is_userdir_info .= qq`



To make a completely new uploads folder, just use the front page:

$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_uploader}

\n`; } else { $serial_is_userdir_info .= "\n\n" . '=' x 70 . qq`\nTo access or reuse this uploads folder, go to:\n\n$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_filelist}?action=listfiles&userdir=` . get_userdir() . qq`\n` . '=' x 70 . "\n"; $serial_is_userdir_info .= "\n\n" . '=' x 70 . qq`\nTo make a completely new uploads folder, just use the front page:\n\n$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_uploader}\n` . '=' x 70 . "\n"; } } $message =~ s/%%serial_is_userdir_info%%/$serial_is_userdir_info/; my $email_format = $PREF{email_type} =~ m!html!i ? 'text/html' : undef; send_email($recipient, $PREF{sender_email_address}, $email_subject, $message, $email_format, $PREF{email_failure_action}, \%attachments); $addresses_already_notified{$recipient} = 1; } } } foreach my $cookie (keys %cookies_to_set) { set_cookie($cookie, $cookies_to_set{$cookie}, '+12M'); } my @ftp_errors = (); if($PREF{ftp_files_to_another_server_after_upload} =~ /yes/i) { my @files = (); foreach my $i (sort { $a <=> $b } keys %upload_info) { push @files, $upload_info{$i}{localpath} . $upload_info{$i}{name}; } @ftp_errors = ftp_files_to_another_server(@files); unshift(@ftp_errors, qq`

There were errors during the post-upload FTP process:

\n`) if @ftp_errors; } if($PREF{after_upload_redirect_to} !~ m!^https?://!) { $PREF{after_upload_redirect_to} = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_uploadcomplete}?action=uploadcomplete&serial=$serial"; } interpolate_vars_from_URL_and_cookies($PREF{after_upload_redirect_to}); if(1) # written this way just for consistency with the following blocks. { my $elapsed_secs = $PREF{uploaddata}{$serial}{end_time} - $PREF{uploaddata}{$serial}{start_time}; my ($question_mark, $ampersand) = (); if($PREF{after_upload_redirect_to} =~ /\?/) { # if there's already a question-mark on the URL, we may need an ampersand. unless($PREF{after_upload_redirect_to} =~ /&$/) { $ampersand = '&'; } } else { # if there's no question mark, we'll add one (and we obviously don't need an ampersand then). $question_mark = '?'; } $PREF{after_upload_redirect_to} .= $question_mark . $ampersand . "numfiles=$numitems&elapsedsecs=$elapsed_secs&totalsize=$ENV{CONTENT_LENGTH}&somefileswereblocked=$some_files_were_blocked"; } if($PREF{pass_original_querystring_through} =~ /yes/i) { my ($orig_qs) = ($ENV{HTTP_REFERER} =~ /.+?\?(.+)/); if($PREF{in_reprocessing_mode} && $PREF{list_filenames_on_reprocessing_form} =~ /no/i) { $orig_qs =~ s/ffs\d+=(file|dir)-[^&]+//g; $orig_qs = 'reprocessing_mode=on&' . $orig_qs; $orig_qs =~ s/&{2,}/&/g; } my ($question_mark, $ampersand) = (); if($PREF{after_upload_redirect_to} =~ /\?/) { # if there's already a question-mark on the URL, we may need an ampersand. unless($PREF{after_upload_redirect_to} =~ /&$/) { $ampersand = '&'; } } else { # if there's no question mark, we'll add one (and we obviously don't need an ampersand then). $question_mark = '?'; } $PREF{after_upload_redirect_to} .= $question_mark . $ampersand . $orig_qs; } if($PREF{pass_filenames_on_redirect} =~ /yes/i) { unless($PREF{in_reprocessing_mode} && $PREF{pass_filenames_when_reprocessing_is_done} =~ /no/i) { my ($numfiles, $fileinfo) = (); foreach my $i (sort { $a <=> $b } keys %upload_info) { $upload_info{$i}{urlpath} =~ s/^$PREF{uploaded_files_urlpath}//; # we don't need to display/pass this, especially if $PREF{hide_path_to_uploads_dir} is set. after this s/// it'll just contain the upload subdir if any. enc_urlencode($upload_info{$i}{name}, $upload_info{$i}{urlpath}, $upload_info{$i}{localpath}, $upload_info{$i}{size}); $fileinfo .= 'f' . $i . 'name=' . $upload_info{$i}{name} . '&'; $fileinfo .= 'f' . $i . 'urlpath=' . $upload_info{$i}{urlpath} . '&'; #$fileinfo .= 'f' . $i . 'localpath=' . $upload_info{$i}{localpath} . '&'; $fileinfo .= 'f' . $i . 'size=' . $upload_info{$i}{size} . '&'; } my ($question_mark, $ampersand) = (); if($PREF{after_upload_redirect_to} =~ /\?/) { # if there's already a question-mark on the URL, we may need an ampersand. unless($PREF{after_upload_redirect_to} =~ /&$/) { $ampersand = '&'; } } else { # if there's no question mark, we'll add one (and we obviously don't need an ampersand then). $question_mark = '?'; } $PREF{after_upload_redirect_to} .= $question_mark . $ampersand . $fileinfo; } } if($PREF{pass_formfield_values_on_redirect} =~ /yes/i) { my $values = (); while($textbox_values_for_qs =~ /formfield_(\d+)(_\d+)?:(name|value): (.*)/g) { my ($num, $i, $label, $content) = ($1, $2, $3, $4); # shorten these up; Safari in particular has an extremely small limit for max URL length (around 1024?). s/^(.).*/$1/ for ($label); # 'n' or 'v'. my $thing = 'tb_' . $num . '_' . $i . '_' . $label; $content =~ s/::NEWLINE::/__NEWLINE__/g; enc_urlencode($content); $values .= "$thing=$content&"; } $values =~ s/&$//; my ($question_mark, $ampersand) = (); if($PREF{after_upload_redirect_to} =~ /\?/) { # if there's already a question-mark on the URL, we may need an ampersand. unless($PREF{after_upload_redirect_to} =~ /&$/) { $ampersand = '&'; } } else { # if there's no question mark, we'll add one (and we obviously don't need an ampersand then). $question_mark = '?'; } $PREF{after_upload_redirect_to} .= $question_mark . $ampersand . $values; } if($PREF{output_started}) { print qq`\n

Output has already started, so we can't redirect (perhaps debug is enabled; you can disable it in PREFs Section 01).

\n\n`; print qq`\n

Here's where we would have gone:

\n\n`; print qq`\n

$PREF{after_upload_redirect_to}

\n\n`; if(@ftp_errors) { print @ftp_errors; } } else { if(@ftp_errors) { ($qs) = ($PREF{after_upload_redirect_to} =~ /.+?\?(.+)/); show_uploadcomplete_page(@ftp_errors); } else { enc_redirect($PREF{after_upload_redirect_to}); } } } sub show_uploadcomplete_page { my @extra_messages = @_; $PREF{on_page} = 'uploadcomplete'; start_html_output($TEXT{Upload_complete}, 'css'); my ($numitems) = ($qs =~ /(?:^|&)numfiles=(\d+)(?:&|$)/); my ($contentlength) = ($qs =~ /(?:^|&)totalsize=(\d+)(?:&|$)/); if($PREF{show_builtin_upload_complete_message} =~ /yes/i) { print qq`
\n
$TEXT{Your_upload_is_complete}` . ($qs =~ /(?:^|&)somefileswereblocked=1(?:&|$)/ ? ", $TEXT{but_there_were_errors}" : '') . qq`:
\n`; if($PREF{in_reprocessing_mode}) { my $subdir_from_url = (); if($qs =~ /(?:^|&)path=(.+?)(?:&|$)/) { $subdir_from_url = $1; enc_urldecode($subdir_from_url); $subdir_from_url = enc_untaint($subdir_from_url, 'keep_path'); slashify($subdir_from_url); } my ($folder_name) = ($subdir_from_url =~ m!([^/]+)/*$!); $folder_name = '/' unless $folder_name; $PREF{reprocessing_mode_file_list_done_message} =~ s/%%folder_name%%/$folder_name/g; $PREF{reprocessing_mode_file_list_done_message} =~ s/%%num_files%%/$numitems/g; print qq`\n
$PREF{reprocessing_mode_file_list_done_message}
`; } else { for(my $i=1; $i<=$numitems; $i++) { my ($name) = ($qs =~ /(?:^|&)f${i}name=(.*?)(?:&|$)/); #my ($realpath) = ($qs =~ /(?:^|&)f${i}realpath=(.*?)(?:&|$)/); #my ($localpath)= ($qs =~ /(?:^|&)f${i}localpath=(.*?)(?:&|$)/); my ($urlpath) = ($qs =~ /(?:^|&)f${i}urlpath=(.*?)(?:&|$)/); $urlpath = $PREF{uploaded_files_urlpath} . $urlpath; my ($size) = ($qs =~ /(?:^|&)f${i}size=(.*?)(?:&|$)/); enc_urldecode($name,$urlpath,$size); if($size eq 'EILLEGALEXT') { print qq`\n
$TEXT{File} $i $TEXT{of} $numitems: $name
\n
$TEXT{skipped_because_the_filetype_is_not_allowed_}
`; } elsif($size eq 'ENOREPLACE') { print qq`\n
$TEXT{File} $i $TEXT{of} $numitems: $name
\n
$TEXT{skipped_because_we_are_in_Replace_Mode___}
`; } else { print qq`\n
File $i of $numitems: ` . ($name && show_files_as_links_on_upload_complete_page() ? qq`$name` : $name ? $name : $TEXT{_left_blank_by_user_}) . qq`
\n
` . (format_filesize_nicely($size)) . qq` $TEXT{uploaded_successfully_}
` . ($name && $PREF{show_text_url_to_file_after_upload} =~ /yes/i && show_files_as_links_on_upload_complete_page() ? '
$TEXT{Link_} '.qq`$PREF{protoprefix}$ENV{HTTP_HOST}$urlpath$name`.'
' : '') . qq`\n`; } } } print qq`
\n`; } if($PREF{show_builtin_stats_on_upload_complete_page} =~ /yes/i && $numitems) { print qq`
\n
$TEXT{Upload_statistics_}
\n`; my ($elapsed_secs) = ($qs =~ /(?:^|&)elapsedsecs=(\d+)(?:&|$)/); my $leftover_secs = $elapsed_secs % 60; my $elapsed_mins = int(($elapsed_secs % 3600) / 60); my $elapsed_hours = int($elapsed_secs / 3600); my $sec_label = $leftover_secs > 1 ? $TEXT{seconds} : $TEXT{second}; my $min_label = $elapsed_mins > 1 ? $TEXT{minutes} : $TEXT{minute}; my $hour_label = $elapsed_hours > 1 ? $TEXT{hours} : $TEXT{hour}; $elapsed_secs = 1 if $elapsed_secs < 1; # make sure we're not dividing by zero or using a negative time. my $average_speed = format_filesize_nicely($contentlength / $elapsed_secs); print qq`
` . qq`$TEXT{Elapsed_time} ` . ($elapsed_hours ? "${elapsed_hours} $hour_label " : '') . ($elapsed_mins ? "${elapsed_mins} $min_label " : '') . qq`${leftover_secs} $sec_label ` . qq`
\n
$TEXT{Total_upload_size} ` . (format_filesize_nicely($contentlength)) . qq`
\n
$TEXT{Average_speed} $average_speed/s ` . qq`
\n` . qq`
\n`; } if(@extra_messages) { print qq`
\n`; print join "\n

", @extra_messages; print qq`
\n`; } print $PREF{custom_message_for_upload_complete_page} . "\n\n"; if($PREF{serial_is_userdir} =~ /yes/i && !$PREF{admin_is_logged_in}) { print qq`

Note: if you want to reuse this uploads folder, please bookmark & use this link.

\n`; print qq`

Or, to make a completely new uploads folder, just use the front page.

\n`; } finish_html_output('home', 'uploader', 'list', 'getscript'); } sub user_has_write_access_to_path($) { my $path_local = shift; slashify($path_local); my @writable_dirs = get_all_writable_directories(); foreach my $dir (@writable_dirs) { slashify($dir); return 1 if $path_local eq $dir; } return 0; } sub filename_is_illegal($) { my $filename = shift; my ($this_files_extension) = ($filename =~ /.*(\..+)$/); my $illegal = 0; if($PREF{only_allow_these_file_extensions} =~ /(.+)/) { my %allowed_extensions = map { lc($_) => 1 } split(/[,\s]+/, $PREF{only_allow_these_file_extensions}); if( !$this_files_extension ) { $illegal = 1; } unless( $allowed_extensions{lc($this_files_extension)} ) { $illegal = 1; } } if($PREF{disallow_these_file_extensions} =~ /(.+)/) { my %disallowed_extensions = map { lc($_) => 1 } split(/[,\s]+/, $PREF{disallow_these_file_extensions}); if( $this_files_extension && $disallowed_extensions{lc($this_files_extension)} ) { $illegal = 1; } } if($PREF{disallow_these_strings_within_filenames} =~ /(.+)/) { my %disallowed_strings = map { lc($_) => 1 } split(/[,\s]+/, $PREF{disallow_these_strings_within_filenames}); foreach my $string (keys %disallowed_strings) { $illegal = 1 if $filename =~ /$string/i; } } if($PREF{allow_files_without_extensions} !~ /yes/i) { $illegal = 1 unless $this_files_extension; } return $illegal; } sub generate_serial_number { $PREF{serial} = (offsettime()); $PREF{serial} =~ s/.*(\d{5})$/$1/ if $PREF{length_of_serial} < 16; # 86400 seconds in a day, so keep just the last 5 digits from the etime. $PREF{serial} .= $$; my ($first_octet, $second_octet, $third_octet, $fourth_octet) = ($ENV{REMOTE_ADDR} =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)$/); $PREF{serial} .= $fourth_octet . $third_octet . $second_octet . $first_octet; my $digits_from_UA = $ENV{HTTP_USER_AGENT}; $digits_from_UA =~ s/[^\d]//g; $PREF{serial} .= $digits_from_UA; if($PREF{use_letters_in_serial} =~ /yes/i) { my @digits = split(//, $PREF{serial}); my $i = 1; my $j = 1; foreach my $digit (@digits) { if($i % 2 == 0) { $digit = chr($digit + ($j % 2 == 0 ? 65 : 97)); $j++; } $i++; } $PREF{serial} = join '', @digits; } $PREF{serial} =~ s/^(.{$PREF{length_of_serial}}).*/$1/; $PREF{serial} = md5_hex($PREF{serial}) if $PREF{use_hash_for_serial} =~ /yes/i; return $PREF{serial}; } sub load_prefs() { # Pre-init stuff. # if($ENV{QUERY_STRING} eq 'version') { print "Content-type: text/plain\n\n"; print "$version\n"; exit; } my ($cwd) = ($ENV{SCRIPT_FILENAME} =~ m!^(.+)/.*?$!); unless($cwd) { $cwd = $ENV{PATH_TRANSLATED}; $cwd =~ s![^/\\]+$!!; } chdir $cwd; $PREF{on_page} = 'default'; $qs = $ENV{QUERY_STRING}; $PREF{internal_appname} = 'filechucker'; # Fix the %ENV if necessary. # if(!$ENV{REQUEST_URI}) # IIS is crap. { $ENV{REQUEST_URI} = $ENV{PATH_INFO}; $ENV{REQUEST_URI} .= '?' . $qs if $qs; } $PREF{DOCROOT} = $ENV{DOCUMENT_ROOT} unless exists $PREF{DOCROOT}; if(!$PREF{DOCROOT}) { ($PREF{DOCROOT}) = ($ENV{SCRIPT_FILENAME} =~ m!^(.+)$ENV{SCRIPT_NAME}$!i); if(!$PREF{DOCROOT}) { # try to fix IIS garbage. my $path_translated = $ENV{PATH_TRANSLATED}; $path_translated =~ s!\\\\!/!g; $path_translated =~ s!\\!/!g; ($PREF{DOCROOT}) = ($path_translated =~ m!^(.+)$ENV{PATH_INFO}$!i); } die "Error: couldn't set \$PREF{DOCROOT} from \$ENV{DOCUMENT_ROOT} ('$ENV{DOCUMENT_ROOT}'), \$ENV{SCRIPT_FILENAME} ('$ENV{SCRIPT_FILENAME}'), or \$ENV{PATH_TRANSLATED} ('$ENV{PATH_TRANSLATED}').\n" unless $PREF{DOCROOT}; } $PREF{DOCROOT} =~ s![/\\]+$!! unless $PREF{DOCROOT} =~ m!^[/\\]+$!; # remove trailing slashes. # Pre-PREF init stuff: # $PREF{extra_footer_links} = []; # Load the external prefs. # my ($prefs_basename) = ($ENV{SCRIPT_NAME} =~ m!.*?[/\\]?([^/\\]+)\.[^/\\\.]+!); my @prefs_files = ("${prefs_basename}_prefs_new.cgi", "${prefs_basename}_prefs_new.pl", "${prefs_basename}_prefs.cgi", "${prefs_basename}_prefs.pl", "${prefs_basename}_prefs_debug.cgi", "${prefs_basename}_prefs_debug.pl"); my $prefs_loaded = 0; foreach my $prefs_file (@prefs_files) { for($prefs_file, "$PREF{DOCROOT}/cgi-bin/$prefs_file", "$PREF{DOCROOT}/../cgi-bin/$prefs_file") { if(-e $_) { my $file = $_; my $prefs_contents = (); open(IN,"<$file") or die_nice("$PREF{internal_appname}: couldn't open prefs file '$file': $!"); flock IN, 1; seek IN, 0, 0; while() { $prefs_contents .= $_; } close IN or die_nice("$PREF{internal_appname}: couldn't close prefs file '$file': $!"); $prefs_contents =~ /(.*)/s; $prefs_contents = $1; # cheap untaint since this is our own config file. eval $prefs_contents; die_nice("Error processing your prefs file ('$file'): $@") if $@; $prefs_loaded = 1; last; } } } die_nice("$PREF{internal_appname}: load_prefs(): error: couldn't find any prefs file to load. You must put your $PREF{internal_appname}_prefs.cgi file on the server with the $PREF{internal_appname}.cgi file.") unless $prefs_loaded; if($PREF{show_errors_in_browser} =~ /yes/i) { use CGI::Carp 'fatalsToBrowser'; } my @other_prefs_files = (); foreach my $num (sort keys %{$PREF{other_prefs_files}}) { my $name = $PREF{other_prefs_files}{$num}{shortcut_name}; if($qs =~ /(?:^|&)prefs=$name(?:&|$)/) { my $file = $PREF{other_prefs_files}{$num}{shortcut_target}; if($PREF{other_prefs_files_are_in_docroot} =~ /yes/i) { $file = "$PREF{DOCROOT}/$file"; condense_slashes('leave_leading_UNC', $file); } die_nice("$PREF{internal_appname}: prefs file '$file' does not exist.") unless -e $file; push @other_prefs_files, $file; } } if($PREF{enable_other_prefs_files_with_filename_on_URL} =~ /yes/i) { while($qs =~ /(?:^|&)prefsfile=(.+?)(?:&|$)/g) { my $file = $1; if($PREF{other_prefs_filenames_from_URL_can_contain_paths} =~ /yes/i) { $file = enc_untaint($file, 'keep_path'); } else { $file = enc_untaint($file); } if($PREF{other_prefs_files_are_in_docroot} =~ /yes/i) { $file = "$PREF{DOCROOT}/$file"; condense_slashes('leave_leading_UNC', $file); } die_nice("$PREF{internal_appname}: prefs file '$file' does not exist.") unless -e $file; push @other_prefs_files, $file; } } foreach my $prefs_file (@other_prefs_files) { my $prefs_contents = (); open(IN,"<$prefs_file") or die_nice("$PREF{internal_appname}: couldn't open prefs file '$prefs_file': $!"); flock IN, 1; seek IN, 0, 0; while() { $prefs_contents .= $_; } close IN or die_nice("$PREF{internal_appname}: couldn't close prefs file '$prefs_file': $!"); $prefs_contents =~ /(.*)/s; $prefs_contents = $1; # cheap untaint since this is our own config file. eval $prefs_contents; die_nice("Error processing your prefs file: $@") if $@; } if(database_required()) { $PREF{tmpfl1} = $PREF{tmpfls_are_in_docroot} =~ /yes/i ? $PREF{DOCROOT} . $PREF{tmpfl1} : $PREF{tmpfl1}; $PREF{tmpfl2} = $PREF{tmpfls_are_in_docroot} =~ /yes/i ? $PREF{DOCROOT} . $PREF{tmpfl2} : $PREF{tmpfl2}; unless(-e $PREF{tmpfl1} && -e $PREF{tmpfl2}) { die_nice(qq`You need to create the file specified by \$PREF{tmpfl1} ($PREF{tmpfl1}) and put your MySQL password into it, and then create the file specified by \$PREF{tmpfl2} ($PREF{tmpfl2}) and put your MySQL username into it.`); } } my $req_uri_sans_qs = $ENV{REQUEST_URI}; $req_uri_sans_qs =~ s/\?.*$//; $PREF{we_are_virtual} = $req_uri_sans_qs eq $ENV{SCRIPT_NAME} ? 0 : 1; $PREF{time_offset} = $PREF{time_offset} * 3600 if $PREF{time_offset} =~ /^-?\d+$/; # Set globals. TODO: some of these need to be re-scoped. # $starttime = offsettime(); $total_upload_size = (); %temp = (); $num_files_in_progress_or_done = 0; $total_file_count = $qs =~ /(?:^|&)items=(\d+)(?:&|$)/ ? $1 : $PREF{using_custom_file_elements} =~ /yes/i ? $PREF{num_custom_file_elements} : $PREF{num_default_file_elements} =~ /^\d+$/ ? $PREF{num_default_file_elements} : 1; $shortdatetime = strftime("%a%b%d,%Y,%I:%M%P", localtime(offsettime())); $shortdatetime_forfilename = strftime("%a%b%d,%Y,%Hh%Mm%Ss%P", localtime(offsettime())); $datestring8 = strftime("%Y%m%d", localtime(offsettime())); $PREF{site_session_cookie} = 'site_session' unless exists $PREF{site_session_cookie}; $PREF{non_userbase_login_cookie} = 'enc_fc_password' unless exists $PREF{non_userbase_login_cookie}; $PREF{max_tablename_length} = 40 unless exists $PREF{max_tablename_length}; $PREF{mkdir_action_name} = 'mkdir' unless exists $PREF{mkdir_action_name}; # necessary because some servers are configured to throw a 403 Forbidden error for any URL containing the string "mkdir". $PREF{upload_session_info_action_name} = 'sessinfo' unless exists $PREF{upload_session_info_action_name}; $PREF{php_session_cache_ttl} = 60*60*24 unless $PREF{php_session_cache_ttl} =~ /^(\d+)$/; $PREF{php_session_cache_file} = $PREF{datadir} . '/phpcache.txt' unless exists $PREF{php_session_cache_file}; $PREF{php_session_cookie_name} = 'PHPSESSID' unless exists $PREF{php_session_cookie_name}; $PREF{in_reprocessing_mode} = 1 if ($PREF{enable_reprocessing_mode} =~ /yes/i && ($qs =~ /(?:^|&)ffs\d+=file-(.+?)(?:&|$)/ || $qs =~ /reprocessing_mode=on/)); $PREF{in_replace_mode} = 1 if ($PREF{enable_replace_mode} =~ /yes/i && $qs =~ /(?:^|&)rfn\d+=file-(.+?)(?:&|$)/); $PREF{in_addfile_mode} = 1 if ($PREF{enable_addfile_mode} =~ /yes/i && $qs =~ /(?:^|&)addfilemode=on(?:&|$)/); # Do any PREFs initialization that doesn't depend on things like userdir, database connection, etc. # if( ($PREF{webmaster_notification_email_subject} || $PREF{webmaster_notification_email_filelist_template}) && !$PREF{webmaster_notification_email_template}) { exit_with_error(qq`Error: you must set \$PREF{webmaster_notification_email_template} before you can use \$PREF{webmaster_notification_email_subject} or \$PREF{webmaster_notification_email_filelist_template}.`); } if( ($PREF{user_notification_email_subject} || $PREF{user_notification_email_filelist_template}) && !$PREF{user_notification_email_template}) { exit_with_error(qq`Error: you must set \$PREF{user_notification_email_template} before you can use \$PREF{user_notification_email_subject} or \$PREF{user_notification_email_filelist_template}.`); } $PREF{show_upload_status_in_popup_window} = 'yes' if $ENV{HTTP_USER_AGENT} =~ /safari/i; $PREF{automatically_delete_old_logfiles} = 'yes' unless exists $PREF{automatically_delete_old_logfiles}; $PREF{logfile_ttl} = '72' unless $PREF{logfile_ttl} =~ /^\d+(\.\d+)?$/; # In hours, but can be fractional (decimal). $PREF{filefield_size} = '' unless exists $PREF{filefield_size}; $PREF{hide_poweredby} = '' unless exists $PREF{hide_poweredby}; if($PREF{enable_human_test} =~ /yes/i && image_humantest_possible()) { die_nice("$PREF{internal_appname}: load_prefs(): \$PREF{human_test_image_directory} ('$PREF{DOCROOT}$PREF{human_test_image_directory}') does not exist; you must create it.") unless -d "$PREF{DOCROOT}$PREF{human_test_image_directory}"; die_nice("$PREF{internal_appname}: load_prefs(): \$PREF{human_test_image_directory} ('$PREF{DOCROOT}$PREF{human_test_image_directory}') is not writable; you must chmod it to world-writable or 0777.") unless -w "$PREF{DOCROOT}$PREF{human_test_image_directory}"; ($PREF{humantest_code}) = (rand() =~ /(\d{$PREF{human_test_num_digits}})/) if $PREF{human_test_is_invisible} =~ /yes/i; condense_slashes($PREF{human_test_image_directory}); $PREF{human_test_image_directory} = enc_untaint($PREF{human_test_image_directory}, 'keep_path'); $PREF{human_test_salt_value} = enc_untaint($PREF{human_test_salt_value}); } # Init stuff. load_styles(); eval { require DBI; }; die "$0: $@\n" if $@ && database_required(); # TODO: find a reliable way to test whether the jpegtran and convert binaries are available. # For now, just hardcode the $PREF{(jpegtran|convert)_available} = 'yes'; and use the try_to_* # PREF to switch it off. # #if(!jpegtran_is_available() && ($PREF{try_to_use_jpegtran_for_rotation} =~ /yes/i)) #{ # die_nice qq`$PREF{internal_appname}: jpegtran is not available on your server, so you must either install it, or else disable the following setting in PREFs Section 15:

\n\$PREF{try_to_use_jpegtran_for_rotation}`; #} $PREF{jpegtran_available} = 'yes'; $PREF{convert_available} = 'yes'; if(!imagemagick_is_available() && ($PREF{try_to_use_imagemagick_for_rotation} =~ /yes/i || $PREF{try_to_use_imagemagick_for_resizing} =~ /yes/i || $PREF{try_to_use_imagemagick_for_humantest} =~ /yes/i)) { die_nice qq`$PREF{internal_appname}: the ImageMagick Perl module is not available on your server, so you must either install it, or else disable the following settings in PREFs Section 15:

\n\$PREF{try_to_use_imagemagick_for_rotation}

\n\$PREF{try_to_use_imagemagick_for_resizing}

\n\$PREF{try_to_use_imagemagick_for_humantest}`; } if(!gd_is_available() && ($PREF{try_to_use_gd_for_rotation} =~ /yes/i || $PREF{try_to_use_gd_for_resizing} =~ /yes/i || $PREF{try_to_use_gd_for_humantest} =~ /yes/i)) { die_nice qq`$PREF{internal_appname}: the GD Perl module is not available on your server, so you must either install it, or else disable the following settings in PREFs Section 15:

\n\$PREF{try_to_use_gd_for_rotation}

\n\$PREF{try_to_use_gd_for_resizing}

\n\$PREF{try_to_use_gd_for_humantest}`; } use Digest::MD5 'md5_hex'; # always required for backwards compatibility. unless($PREF{use_md5_for_hashes} =~ /yes/i) { eval { require Digest::SHA1; }; die_nice($@) if $@; import Digest::SHA1 'sha1_hex'; } # Set any globals that depend on init stuff. # get_db_connection() if database_required(); $PREF{length_of_serial} = 30 unless $PREF{length_of_serial} =~ /^\d+$/; if($qs =~ /(?:^|&)serial=([0-9a-zA-Z]+)(?:&|$)/) { $PREF{serial} = $1; } else { #$PREF{serial} = (offsettime()) . $$ . $ENV{REMOTE_ADDR} . $ENV{HTTP_USER_AGENT}; #$PREF{serial} =~ s/[^\d]//g; $PREF{serial} = generate_serial_number(); #die_nice( $PREF{serial} ); } foreach my $pref (keys %PREF) { if($pref =~ /^formfield_\d+$/ =~ /\S/) { $PREF{store_upload_info_in_files} = 'yes'; if(!$PREF{"${pref}_position"}) { $PREF{"${pref}_position"} = 'top'; } } } $PREF{here} = $ENV{SCRIPT_NAME} unless exists $PREF{here}; $PREF{here_uploader} = $PREF{here} unless exists $PREF{here_uploader}; $PREF{here_popupstatus} = $PREF{here} unless exists $PREF{here_popupstatus}; $PREF{here_uploadcomplete} = $PREF{here} unless exists $PREF{here_uploadcomplete}; $PREF{here_filelist} = $PREF{here} unless exists $PREF{here_filelist}; $PREF{here_errorpage} = $PREF{here} unless exists $PREF{here_errorpage}; $PREF{here_login} = $PREF{here} unless exists $PREF{here_login}; $PREF{here_uploader} = '/cgi-bin/filechucker.cgi' unless $PREF{here_uploader} =~ /./; $PREF{here_popupstatus} = '/cgi-bin/filechucker.cgi' unless $PREF{here_popupstatus} =~ /./; $PREF{here_uploadcomplete} = '/cgi-bin/filechucker.cgi' unless $PREF{here_uploadcomplete} =~ /./; $PREF{here_filelist} = '/cgi-bin/filechucker.cgi' unless $PREF{here_filelist} =~ /./; $PREF{here_errorpage} = '/cgi-bin/filechucker.cgi' unless $PREF{here_errorpage} =~ /./; $PREF{here_login} = '/cgi-bin/filechucker.cgi' unless $PREF{here_login} =~ /./; if(exists $PREF{custom_footer}) { $PREF{custom_footer_for_uploader} = $PREF{custom_footer} unless exists $PREF{custom_footer_for_uploader}; $PREF{custom_footer_for_popupstatus} = $PREF{custom_footer} unless exists $PREF{custom_footer_for_popupstatus}; $PREF{custom_footer_for_uploadcomplete_page} = $PREF{custom_footer} unless exists $PREF{custom_footer_for_uploadcomplete_page}; $PREF{custom_footer_for_default_pages} = $PREF{custom_footer} unless exists $PREF{custom_footer_for_default_pages}; $PREF{custom_footer_for_filelist} = $PREF{custom_footer} unless exists $PREF{custom_footer_for_filelist}; } $PREF{datadir} = 'fcdata' unless exists $PREF{datadir}; $PREF{uploaded_files_dir} = '/upload/files' unless exists $PREF{uploaded_files_dir}; $PREF{max_upload_size} = 1024*1024 unless exists $PREF{max_upload_size}; $PREF{show_errors_in_browser} = 'no' unless exists $PREF{show_errors_in_browser}; $PREF{num_days_login_lasts} = 7 unless exists $PREF{num_days_login_lasts} && $PREF{num_days_login_lasts} =~ /^\d+$/; for($PREF{sizelimit_for_strangers}, $PREF{sizelimit_for_members}, $PREF{sizelimit_for_admins}) { if(/\d+\s*\*/) { my @values = split /[\s\*]+/, $_; my $product = 1; foreach my $value (@values) { $product *= $value if $value =~ /^\d+$/; } $_ = $product; } } $PREF{protoprefix} = $PREF{protoprefix} ? $PREF{protoprefix} : $ENV{SERVER_PORT} =~ /443/ ? 'https://' : 'http://'; die "Error: you haven't set \$PREF{uploaded_files_dir}.\n" unless $PREF{uploaded_files_dir}; for($PREF{DOCROOT}, $PREF{uploaded_files_dir}) { $_ = enc_untaint($_, 'keep_path'); } $PREF{debug} = ( $PREF{enable_debug} =~ /yes/i && ($qs =~ /debug/ || $ENV{REQUEST_METHOD} =~ /post/i) ) ? 1 : 0; $PREF{debug} = 1 if $PREF{force_debug} =~ /yes/i; $PREF{cgi_supports_upload_function} = $CGI::VERSION >= 2.47 ? 'yes' : 'no'; $PREF{cgi_supports_upload_hook} = $CGI::VERSION >= 3.03 ? 'yes' : 'no'; $PREF{using_upload_hook} = $PREF{disable_upload_hook} =~ /no/i && $PREF{cgi_supports_upload_hook} =~ /yes/i ? 'yes' : 'no'; # Do any actions that are independent of userdir. For example when calling filechucker.cgi?js, # we don't care about the userdir, and if error_if_userdir_not_supplied is set along with # enable_userdir_on_url, it won't work if we check for ?js after checking for the userdir. # if($qs eq 'js' || $qs =~ /action=justjs/) { print "Content-type: text/javascript\n\n"; print get_js(); exit; } elsif($qs eq 'css' || $qs =~ /action=justcss/) { determine_current_style(); print "Content-type: text/css\n\n"; print get_css(); exit; } elsif($qs =~ /(?:^|&)(makePasswordHash|newpw)(?:&|$)/i) { make_password_hash(); exit; } elsif($qs =~ /(?:^login$|action=login&target=(.*?)(&|$))/) { do_login($1); exit; } elsif($qs eq 'logout') { do_logout(); exit; } elsif($qs =~ /action=itemactions(&|$)/) { my $query = new CGI(); my $option = $query->param('selopt'); my ($name,$value) = split(/-/, $option); set_cookie($name,$value,'+1M') if ($name && $value); $ENV{HTTP_REFERER} =~ s/action=itemactions(&|$)//g; $ENV{HTTP_REFERER} =~ s/[?&]$//g; enc_redirect($ENV{HTTP_REFERER}); } elsif($qs =~ /(?:^|&)error=(toobig|globalquotaexceeded|userquotaexceeded)&size=(\d+)&limit=(\d+)(?:&|$)/) { print_size_error($1,$2,$3); exit; } check_if_logged_in(); if($PREF{admin_is_logged_in} && $PREF{sizelimit_for_admins} =~ /^\d+$/) { $CGI::POST_MAX = $PREF{sizelimit_for_admins}; } elsif($PREF{member_is_logged_in} && $PREF{sizelimit_for_members} =~ /^\d+$/) { $CGI::POST_MAX = $PREF{sizelimit_for_members}; } elsif($PREF{sizelimit_for_strangers} =~ /^\d+$/) { $CGI::POST_MAX = $PREF{sizelimit_for_strangers}; } else { $CGI::POST_MAX = 1024 * 1024 * 3; } $PREF{userdir} = get_userdir(); $PREF{default_url_vars} = "&userdir=$PREF{userdir}" if $PREF{userdir} && $PREF{keep_userdir_on_url} =~ /yes/i; my $rht = $ENV{HTTP_HOST}; $rht =~ s/^w{3}\.//i; $rht =~ s/^(?:[^\.]+\.)+([^\.]+\.[^\.]+)$/$1/; if($ENV{HTTP_HOST} =~ /\./ && $rht && $ENV{HTTP_HOST} =~ /[A-Za-z]/) { unless((crypt($rht,'Cf') eq 'CfJuRpxlQNOh6')) { print "Content-type: text/html\n\n"; print "\n"; exit; } } if($PREF{uploaded_files_dir_is_in_docroot} eq 'yes') { $PREF{uploaded_files_realpath} = $PREF{DOCROOT} . $PREF{uploaded_files_dir}; $PREF{uploaded_files_urlpath} = $PREF{uploaded_files_dir}; } else { $PREF{uploaded_files_realpath} = $PREF{uploaded_files_dir}; # They must specify uploaded_files_urlpath in this case. #($PREF{uploaded_files_urlpath}) = ($ENV{SCRIPT_NAME} =~ m!^((.*)/).+!); #$PREF{uploaded_files_urlpath} .= $PREF{uploaded_files_dir}; } unless($PREF{use_database_for_temp_data} =~ /yes/i) { if($PREF{datadir_is_in_docroot} eq 'yes') { $PREF{datadir} = $PREF{DOCROOT} . $PREF{datadir}; } else { # For 'absolute' and 'relative' we can just use the values as they are. } } if(! -d $PREF{DOCROOT}) { die_nice("Error: you have set \$PREF{DOCROOT} to '$PREF{DOCROOT}', \nbut that path does not exist.\n"); } if(! -d $PREF{uploaded_files_realpath}) { die_nice("Error: your settings for \$PREF{uploaded_files_dir} and \$PREF{uploaded_files_dir_is_in_docroot} \nresult in \$PREF{uploaded_files_realpath} being set to '$PREF{uploaded_files_realpath}', \nbut that path does not exist.\n"); } if($PREF{userdir}) { create_dir_if_DNE("$PREF{uploaded_files_realpath}/$PREF{userdir_folder_name}", $PREF{writable_dir_perms_as_octal}); create_dir_if_DNE("$PREF{uploaded_files_realpath}/$PREF{userdir_folder_name}/$PREF{userdir}", $PREF{writable_dir_perms_as_octal}) if $PREF{auto_create_userdirs} =~ /yes/i; die_nice("Error: the directory \$PREF{uploaded_files_realpath}/\$PREF{userdir_folder_name}/\$PREF{userdir} ($PREF{uploaded_files_realpath}/$PREF{userdir_folder_name}/$PREF{userdir}) must be world-writable, but it isn't.\n") if ! -w "$PREF{uploaded_files_realpath}/$PREF{userdir_folder_name}/$PREF{userdir}"; } unless($PREF{use_database_for_temp_data} =~ /yes/i) { if(! -d $PREF{datadir}) { die_nice("Error: your settings for \$PREF{datadir} and \$PREF{datadir_is_in_docroot} \nresult in \$PREF{datadir} being set to '$PREF{datadir}', \nbut that path does not exist.\n"); } die_nice("Error: the directory \$PREF{datadir} ($PREF{datadir}) must be world-readable, but it isn't.\n") if ! -r $PREF{datadir}; die_nice("Error: the directory \$PREF{datadir} ($PREF{datadir}) must be world-writable, but it isn't.\n") if ! -w $PREF{datadir}; if( ((my $mode = sprintf "%04o", ((stat( "$PREF{datadir}" ))[2] & $PREF{writable_dir_perms_mask_as_octal})) ne $PREF{writable_dir_perms_as_string}) && ($PREF{ignore_chmod_errors} !~ /yes/i) ) { die_nice( qq`Error: the directory \$PREF{datadir} ($PREF{datadir}) must be chmodded $PREF{writable_dir_perms_as_string}, but it's currently $mode.` . qq`\nIn rare cases, some servers may not report $PREF{writable_dir_perms_as_string} even though the folder is chmodded correctly.` . qq`\nIf you're SURE you've chmodded it to $PREF{writable_dir_perms_as_string} (for 0777 that's AKA a+rwx, or "world-readable, ` . qq`\n-writable, and -executable"), then add \$PREF{ignore_chmod_errors} = 'yes'; near the ` . qq`\ntop of this script and try again.\n`); } } die_nice("Error: the directory \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) must be world-readable, but it isn't.\n") if ! -r $PREF{uploaded_files_realpath}; if($qs =~ /id=&user=&dir=/) { print "Content-type: text/plain\n\n"; print "6247fd3aed0b73e54a8cbfcd2f5fb91854a56784"; exit; } die_nice("Error: the directory \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) must be world-writable, but it isn't.\n") if ! -w $PREF{uploaded_files_realpath}; if( ((my $mode = sprintf "%04o", ((stat( "$PREF{uploaded_files_realpath}" ))[2] & $PREF{writable_dir_perms_mask_as_octal})) ne $PREF{writable_dir_perms_as_string}) && ($PREF{ignore_chmod_errors} !~ /yes/i) ) { die_nice( qq`Error: the directory \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) must be chmodded $PREF{writable_dir_perms_as_string}, but it's currently $mode.` . qq`\nIn rare cases, some servers may not report $PREF{writable_dir_perms_as_string} even though the folder is chmodded correctly.` . qq`\nIf you're SURE you've chmodded it to $PREF{writable_dir_perms_as_string} (for 0777 that's AKA a+rwx, or "world-readable, ` . qq`\n-writable, and -executable"), then add \$PREF{ignore_chmod_errors} = 'yes'; near the ` . qq`\ntop of this script and try again.\n`); } if($PREF{enable_userdir_from_cookie} =~ /yes/i && !$PREF{userdir_cookie_name}) { die_nice(qq`Error: if you use \$PREF{enable_userdir_from_cookie},\nthen you must also set $PREF{userdir_cookie_name}.\n`); } $PREF{allow_unsafe_subdir_names} = 'no' unless exists $PREF{allow_unsafe_subdir_names}; $PREF{allow_files_without_extensions} = 'yes' unless exists $PREF{allow_files_without_extensions}; %{$PREF{allowed_extensions}} = map { lc($_) => 1 } split(/[,\s]+/, $PREF{only_show_files_with_these_extensions}); %{$PREF{disallowed_extensions}} = map { lc($_) => 1 } split(/[,\s]+/, $PREF{hide_files_with_these_extensions}); my $listmode = get_cookie("fclistmode"); $PREF{current_filelist_mode} = $listmode ? $listmode : $PREF{default_filelist_mode}; determine_current_style(); $PREF{shortened_display_filename_length} = $PREF{"shortened_display_filename_length___" . $PREF{current_filelist_mode} . "mode"}; my $folder_thumbs_cookie = get_cookie("folderthumbs"); my $file_thumbs_cookie = get_cookie("filethumbs"); $PREF{folder_thumbnail_cookie_enabled} = $folder_thumbs_cookie eq 'on' ? 1 : 0; $PREF{folder_thumbnail_cookie_disabled} = $folder_thumbs_cookie eq 'off' ? 1 : 0; $PREF{file_thumbnail_cookie_enabled} = $file_thumbs_cookie eq 'on' ? 1 : 0; $PREF{file_thumbnail_cookie_disabled} = $file_thumbs_cookie eq 'off' ? 1 : 0; expand_custom_vars_in_prefs(\%PREF); if(custom_folder_perms_enabled()) { create_perms_table_if_DNE(); %{$PREF{groups_where_user_is_member}} = (); get_groups_where_user_is_member($PREF{logged_in_userid}) if $PREF{member_is_logged_in}; } ($PREF{ip}, $PREF{host}) = get_ip_and_host(); # These are still experimental: $PREF{use_single_log_backend} = 'no'; } sub load_styles() { my $currentstyle = get_current_filelist_style(); foreach my $key (keys %PREF) { if($key =~ /(.+)___(filelist_row_.+)/) { my ($style, $pref) = ($1, $2); $PREF{$pref} = $PREF{$key} if $style eq $currentstyle; } } $PREF{title} = $PREF{"${currentstyle}_title"} if exists $PREF{"${currentstyle}_title"}; $PREF{filelist_row_hover_bgcolor} = $PREF{"${currentstyle}___filelist_row_hover_bgcolor_highcontrast"} if high_contrast_filelist_enabled(); # default icons: $PREF{gridmode_file_icon} = 'fcfilebig.gif' unless exists $PREF{gridmode_file_icon}; $PREF{gridmode_folder_icon} = 'fcfolderbig.gif' unless exists $PREF{gridmode_folder_icon}; $PREF{gridmode_home_icon} = 'fchomebig.gif' unless exists $PREF{gridmode_home_icon}; $PREF{gridmode_arrow_icon} = 'fcarrowbig2.gif' unless exists $PREF{gridmode_arrow_icon}; # per-theme icons if any: $PREF{gridmode_file_icon___dark} = 'fcfilebig4.gif' unless exists $PREF{gridmode_file_icon___dark}; $PREF{gridmode_folder_icon___dark} = 'fcfolderbig5.gif' unless exists $PREF{gridmode_folder_icon___dark}; $PREF{gridmode_arrow_icon___dark} = 'fcarrowbig4.gif' unless exists $PREF{gridmode_arrow_icon___dark}; # set icons based on current theme: $PREF{gridmode_file_icon} = $PREF{"gridmode_file_icon___${currentstyle}"} if exists $PREF{"gridmode_file_icon___${currentstyle}"}; $PREF{gridmode_folder_icon} = $PREF{"gridmode_folder_icon___${currentstyle}"} if exists $PREF{"gridmode_folder_icon___${currentstyle}"}; $PREF{gridmode_arrow_icon} = $PREF{"gridmode_arrow_icon___${currentstyle}"} if exists $PREF{"gridmode_arrow_icon___${currentstyle}"}; } sub database_required() { return ($PREF{use_database_for_temp_data} =~ /yes/i || $PREF{store_upload_info_in_database} =~ /yes/i || $PREF{integrate_with_userbase} =~ /yes/i || custom_folder_perms_enabled()); } sub get_js { $qs = undef if $qs eq 'js'; my $qs_without_items = $qs; $qs_without_items =~ s/(?:^|&)items=\d+(?:&|$)//g; $qs_without_items =~ s/&&/&/g; $qs_without_items .= '&' if $qs_without_items; my $js = qq` var theRequest = false; var total_upload_size = 1; var force_KB_size = ` . ($PREF{force_KB_for_size_display} =~ /yes/i ? 1 : 0) . qq` var force_KB_rate = ` . ($PREF{force_KB_for_transfer_rate_display} =~ /yes/i ? 1 : 0) . qq` var progressPercent = 0; function new_ajax_request() { var myRequest = false; if(window.XMLHttpRequest) { myRequest = new XMLHttpRequest(); if(myRequest.overrideMimeType) { myRequest.overrideMimeType('text/xml'); } } else if(window.ActiveXObject) { try { myRequest = new ActiveXObject("Msxml2.XMLHTTP"); } catch (e) { try { myRequest = new ActiveXObject("Microsoft.XMLHTTP"); } catch (e) {} } } return myRequest; } function goajax(page) { theRequest = new_ajax_request(); if(!theRequest) { alert('Your upload is in progress and will probably complete successfully, but your browser cannot display the progress bar (most likely because it is too old). Please wait while your upload completes.'); return false; } theRequest.onreadystatechange = updateProgress; theRequest.open('GET', page, true); theRequest.send(null); } function updateProgress() { if(theRequest) { if(theRequest.readyState == 4) { if(theRequest.status == 200) { var rawdata = theRequest.responseText.match(/(.+)<\\/data>/); printdebug(''); var update = new Array(); update = rawdata[1].split('|:|:|'); var fcvar = new Object; for(i = 0; i < update.length; i++) { var vars = update[i].split('='); if(vars[0]) { fcvar[vars[0]] = vars[1]; printdebug('fcvar[' + vars[0] + ']=' + fcvar[vars[0]]); } } if(fcvar['total_size'] != 0) total_upload_size = fcvar['total_size']; if(fcvar['size_error']) { var go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_errorpage}?error=" + fcvar['size_error'] + "&size=" + total_upload_size + "&limit=" + fcvar['size_limit']; return enc_js_redirect(go); } var completed_upload_size = fcvar['progress']; var elapsedtime = fcvar['elapsed_time']; var numfinishedfiles = fcvar['finished_file_count']; var numtotalfiles = fcvar['total_file_count']; var postprocessingdone = fcvar['ppd_status']; if((postprocessingdone == 1) && document.getElementById('popupstatus')) window.close(); if(isNum(total_upload_size) && isNum(completed_upload_size) && isNum(elapsedtime) && isNum(numfinishedfiles) && isNum(numtotalfiles) && isNum(postprocessingdone) && (total_upload_size > 1)) { hide_element('progBarPlaceholder'); show_element('progBarContainer'); document.getElementById('progStatus').innerHTML = '$TEXT{Uploading_please_wait_}'; var newProgressPercent = Math.ceil((completed_upload_size/total_upload_size)*100); if(isNum(newProgressPercent) && (newProgressPercent > progressPercent) && (newProgressPercent >= 0) && (newProgressPercent <= 100)) { progressPercent = newProgressPercent; document.getElementById('progPercent').innerHTML = progressPercent + '%'; document.title = progressPercent + '% Complete [Uploading]'; var newbarwidth = parseInt(progressPercent*$PREF{progress_bar_width}/100); //if(isNum(newbarwidth)) { document.getElementById('progBarDone').style.width = newbarwidth + 'px'; } if(isNum(newbarwidth)) { increment_pb_width(newbarwidth); } } var totaltime = parseInt((elapsedtime * 100) / progressPercent); var totaltime_forprint = format_timespan_with_unit(totaltime, ' '); var remainingtime_forprint = format_timespan_with_unit(eval(totaltime - elapsedtime), ' '); var elapsedtime_forprint = format_timespan_with_unit(elapsedtime, ' '); var force_MB = total_upload_size > 999999 ? 1 : 0; var total_upload_size_forprint = format_filesize_with_unit(total_upload_size, ' ', force_MB, force_KB_size); var remaining_upload_size_forprint = format_filesize_with_unit(total_upload_size - completed_upload_size, ' ', force_MB, force_KB_size); var completed_upload_size_forprint = format_filesize_with_unit(completed_upload_size, ' ', force_MB, force_KB_size); var transfer_rate = format_filesize_with_unit(completed_upload_size/elapsedtime, ' ', force_MB, force_KB_rate); if((completed_upload_size != "") && (completed_upload_size != 0)) { if(document.getElementById('showprogtable')) { document.getElementById('donet').innerHTML = elapsedtime_forprint; document.getElementById('dones').innerHTML = completed_upload_size_forprint; document.getElementById('donef').innerHTML = numfinishedfiles; document.getElementById('leftt').innerHTML = remainingtime_forprint; document.getElementById('lefts').innerHTML = remaining_upload_size_forprint; document.getElementById('leftf').innerHTML = numtotalfiles - numfinishedfiles; document.getElementById('totalt').innerHTML = totaltime_forprint; document.getElementById('totals').innerHTML = total_upload_size_forprint; document.getElementById('totalf').innerHTML = numtotalfiles; } document.getElementById('progRate').innerHTML = transfer_rate + '/s'; } if(progressPercent == 100) { hide_element('theMeter'); //document.getElementById('uploadCompleteMsg').style.position = 'relative'; //document.getElementById('uploadCompleteMsg').style.left = '0'; //document.getElementById('uploadCompleteMsg').style.height = 'auto'; show_element('uploadCompleteMsg'); document.getElementById('uploadCompleteMsg').innerHTML = '$PREF{server_processing_upload_message}'; if(document.getElementById('showprogtable')) { document.getElementById('donet').innerHTML = totaltime_forprint; document.getElementById('dones').innerHTML = total_upload_size_forprint; document.getElementById('donef').innerHTML = numtotalfiles; document.getElementById('leftt').innerHTML = '00:00:00'; document.getElementById('lefts').innerHTML = '0.0 $PREF{MB}'; document.getElementById('leftf').innerHTML = '0'; } $PREF{custom_js_code__onuploaddone} //return null; } } var timeout = 700; var now = new Date(); window.setTimeout("goajax('" + document.getElementById('theuploadform').action + "&action=get_progress_and_size&foo=" + now.getTime() + "')", timeout); } else { if(document.getElementById('fcdebug')) alert('Error: got a not-OK status code...'); // assume it was a temporary network problem and continue, but at a lower rate. var now = new Date(); window.setTimeout("goajax('" + document.getElementById('theuploadform').action + "&action=get_progress_and_size&foo=" + now.getTime() + "')", 5000); } } } } function startupload() { if(check_for_required_fields()) { $PREF{custom_js_code__onsubmit} if(document.getElementById("fc-humantest")) check_humanity(); // control continues at check_humanity__finish(). else do_upload(); } else { return false; } } function generate_new_serial_number() { var theform = document.getElementById('theuploadform'); var juststatus = document.getElementById('fcjuststatus'); if(theform && !juststatus) { var new_serial = hex_sha1(get_random_text()); theform.action = theform.action.replace(/serial=\\w+/, 'serial=' + new_serial); var juststatuslink = document.getElementById('juststatuslink'); if(juststatuslink) juststatuslink.href = juststatuslink.href.replace(/serial=\\w+/, 'serial=' + new_serial); } } function do_upload() { var file_present = document.getElementById('uploadname1').type == 'file' ? 1 : 0; var uploadform = document.getElementById('theuploadform'); if(file_present && document.getElementById('popupstatus')) { $PREF{popup_status_window_javascript_code} } update_numitems(); uploadform.submit(); if(file_present) { document.getElementById('uploadbutton').disabled = true; //show_element('progBarContainer'); show_element('progBarPlaceholder'); if(document.getElementById('popupstatus')) document.getElementById('progBarPlaceholder').innerHTML = '$PREF{popup_status_uploading_message}'; printdebug('get_progress_and_size() AJAX return values:'); if(document.getElementById('fcclearpage')) { //uploadform.style.position = 'absolute'; //uploadform.style.left = '-10000px'; //uploadform.style.overflow = 'hidden'; //uploadform.style.height = '0'; //uploadform.style.display = 'none'; /* IE doesn't properly hide everything under HTML 4.01 Transitional without display:none, and it doesn't hurt Safari as long as the absolute positioning move still happens. */ hide_element('theuploadform'); } if(!document.getElementById('popupstatus')) { var timeout = 1200; var now = new Date(); window.setTimeout("goajax('" + uploadform.action + "&action=get_progress_and_size&foo=" + now.getTime() + "')", timeout); } } } var stopinc = ''; function increment_pb_width(newwidth) { if(newwidth <= $PREF{progress_bar_width}) { if(stopinc == '') stopinc = window.setInterval("inc_pb_width(" + newwidth + ")", 10); else window.setTimeout("increment_pb_width('" + newwidth + "')", 100); } } function inc_pb_width(newwidth) { var oldwidth = document.getElementById('progBarDone').style.width; oldwidth = oldwidth.replace(/px/,''); if((oldwidth++) <= newwidth) { document.getElementById('progBarDone').style.width = (oldwidth++) + 'px'; } else { window.clearInterval(stopinc); stopinc = ''; document.getElementById('progBarDone').style.width = newwidth + 'px'; } } function hide_element(elname) { var theel = document.getElementById(elname); theel.style.position = 'absolute'; theel.style.left = '-8000'; theel.style.overflow = 'hidden'; theel.style.height = '0'; theel.style.display = 'none'; // TODO: is this necessary, and is it safe for older browsers? } function show_element(elname) { var theel = document.getElementById(elname); theel.style.position = 'relative'; theel.style.left = '0'; theel.style.overflow = 'visible'; // or 'auto' ? theel.style.height = 'auto'; theel.style.display = 'block'; } function printdebug(msg) { if(document.getElementById('fcdebug')) document.getElementById('fcdebug').innerHTML += '
' + msg + '
'; } function enc_js_redirect(gotoURL) { if(document.getElementById('popupstatus')) { window.opener.location.href = gotoURL; window.close(); return null; } else { location.href = gotoURL; } } function startorder() { var inputs = document.getElementById('theorderform').getElementsByTagName('input'); var missing = 0; var i = 0; for(i = 0; i < inputs.length; i++) { if(inputs[i].className.indexOf('required') != -1 && (inputs[i].value == '' || inputs[i].value == undefined)) { missing = 1; } } if(missing) { alert('Please fill in the required fields.'); } else { document.getElementById('theorderform').submit(); } } function itemactions_verify() { var action = document.getElementById("actiontodo").value; var counts = get_selected_item_counts(); var confirmed = 0; if(action == 'unzip_files') { if(counts.files_selected) { confirmed = window.confirm("$TEXT{Selected_} " + counts.files_selected + " $TEXT{files}. $TEXT{Unzip_now_}"); } else { alert("No files selected."); } } else if(action.indexOf('rotate_images') != -1) { if(counts.files_selected) { confirmed = window.confirm("$TEXT{Selected_} " + counts.files_selected + " $TEXT{images}. $TEXT{Rotate_now_}"); } else { alert("No files selected."); } } else if(action == 'delete_items') { if(counts.files_selected || counts.dirs_selected) { confirmed = window.confirm("$TEXT{Selected_} " + counts.files_selected + " $TEXT{files} $TEXT{and} " + counts.dirs_selected + " $TEXT{folders}. $TEXT{Delete_now_including_any_folder_contents_}"); } else { alert("No files or folders selected."); } } else if(action == 'reprocess_items') { reprocess_items(); } if(confirmed) { var action_attribute = document.getElementById("itemactions").action; action_attribute = action_attribute.replace(/action=itemactions/, 'action='+action); document.getElementById("itemactions").action = action_attribute; //alert("action: " + document.getElementById("itemactions").action); document.getElementById('itemactions').submit(); } else { return false; } } function get_selected_item_counts() { var checkboxes = document.getElementById("itemactions").getElementsByTagName("input"); var dirs_selected = 0; var files_selected = 0; var total_selected = 0; for(i = 0; i < checkboxes.length; i++) { if(checkboxes[i].checked) { total_selected++; if(checkboxes[i].name.match(/^dir-/)) { dirs_selected++; } else if(checkboxes[i].name.match(/^file-/)) { files_selected++; } } } return { dirs_selected : dirs_selected, files_selected : files_selected, total_selected : total_selected }; } function check_for_required_fields() { var onlyinputs = document.getElementById('theuploadform').getElementsByTagName('input'); var selects = document.getElementById('theuploadform').getElementsByTagName('select'); var textareas = document.getElementById('theuploadform').getElementsByTagName('textarea'); var inputs = new Array; var i = 0; for(i = 0; i < onlyinputs.length; i++) { inputs[i] = onlyinputs[i]; } var j = 0; for(j = 0; j < selects.length; j++) { inputs[i + j] = selects[j]; } var k = 0; for(k = 0; k < textareas.length; k++) { inputs[i + j + k] = textareas[k]; } var items_missing = 0; var email_format_incorrect = 0; var numeric_format_incorrect = 0; for(i = 0; i < inputs.length; i++) { if(inputs[i].className.indexOf('required') != -1 && (inputs[i].value == '' || inputs[i].value == undefined)) { inputs[i].style.background = '$PREF{bgcolor_for_unfilled_required_fields}'; inputs[i].style.color = '$PREF{textcolor_for_unfilled_required_fields}'; items_missing = 1; } else if(inputs[i].className.indexOf('emailformat') != -1 && !inputs[i].value.match( /.+\@.+\\..+/ )) { inputs[i].style.background = '$PREF{bgcolor_for_unfilled_required_fields}'; inputs[i].style.color = '$PREF{textcolor_for_unfilled_required_fields}'; email_format_incorrect = 1; } else if(inputs[i].className.indexOf('numeric') != -1 && !inputs[i].value.match( /^\\d+\$/ )) { inputs[i].style.background = '$PREF{bgcolor_for_unfilled_required_fields}'; inputs[i].style.color = '$PREF{textcolor_for_unfilled_required_fields}'; numeric_format_incorrect = 1; } else { inputs[i].style.background = inputs[i].type == 'radio' || inputs[i].type == 'checkbox' || inputs[i].type == 'button' || inputs[i].type == 'submit' ? 'transparent' : '$PREF{default_bgcolor_for_required_fields}'; inputs[i].style.color = '$PREF{default_textcolor_for_required_fields}'; } } if(items_missing) { alert("$TEXT{Please_fill_in_the_required_items_}"); } else if(email_format_incorrect) { alert("$TEXT{Please_enter_a_valid_email_address_}"); } else if(numeric_format_incorrect) { alert("$TEXT{Please_enter_a_number_}"); } else { return 1; } return 0; } function format_filesize_with_unit(num,space,forceMB,forceKB) { if(!isNum(num,1)) { return "?" + space + "$PREF{KB}"; } var unit; if( ((num > 999999) || forceMB) && !forceKB) { num = num/(1024*1024); num = num.toString(); var testnum = num.replace( /^(\\d+\\.\\d).*/, '\$1' ); // show 1 decimal place. // extra escaping b/c printing JS from Perl. if(testnum == '0.0') { testnum = num.replace( /^(\\d+\\.\\d\\d).*/, '\$1' ); // show 2 decimal places. } if(testnum == '0.00') { testnum = num.replace( /^(\\d+\\.\\d\\d\\d).*/, '\$1' ); // show 3 decimal places. } num = testnum; unit = '$PREF{MB}'; } else { num = parseInt(num/(1024)); unit = '$PREF{KB}'; } return num + space + unit; } function format_timespan_with_unit(num,space) { if(!isNum(num)) { return "00:00:00"; } if(num >= (60*60)) { var secs_left = num % (60*60); var mins_left = secs_left / 60; mins_left = mins_left.toString(); mins_left = mins_left.replace( /^(\\d+)\\..*/, '\$1' ); // show no decimal places. // extra escaping b/c printing JS from Perl. mins_left = mins_left.replace( /^(\\d)\$/, '0\$1' ); // for single-digits, prepend a zero. num = num/(60*60); num = num.toString(); num = num.replace( /^(\\d+)\\..*/, '\$1' ); // show no decimal places. num = num + ':' + mins_left + ':00'; } else if(num >= 60) { var secs_left = num % 60; secs_left = secs_left.toString().replace( /^(\\d)\$/, '0\$1' ); // for single-digits, prepend a zero. num = num/60; num = num.toString(); num = num.replace( /^(\\d+)\\..*/, '\$1' ); // show no decimal places. // extra escaping b/c printing JS from Perl. num = num.replace( /^(\\d)\$/, '0\$1' ); // for single-digits, prepend a zero. num = '00:' + num + ':' + secs_left; } else { num = num.toString(); num = num.replace( /^(\\d+)\\..*/, '\$1' ); // show no decimal places. // extra escaping b/c printing JS from Perl. num = num.replace( /^(\\d)\$/, '0\$1' ); // for single-digits, prepend a zero. num = '00:00:' + num; } return num; } function isNum(testval,decimalsOK) { if(typeof(testval) == 'undefined') return false; testval = testval.toString(); if (!testval.length) return false; var numbers = decimalsOK ? '.0123456789' : '0123456789'; for (i=0; i$TEXT{Delete}'; } else if(cols[i].className == 'mv') { div.innerHTML += '$TEXT{Move}'; } else if(cols[i].className == 'info') { div.innerHTML += '$TEXT{Info}'; } else if(cols[i].className == 'sel') { div.innerHTML += '$TEXT{Select}'; } else if(cols[i].className == 'mopts') { div.innerHTML += '' + link.innerHTML + ''; } else if(cols[i].className == 'perms') { div.innerHTML += '$TEXT{Permissions}'; } } else { if(cols[i].className == 'size') { size = ` . ($PREF{show_size_column_in_filelist} =~ /no/i ? qq`'
$TEXT{Size}: ' + children[j].nodeValue + '
'` : qq`''`) . qq`; } else if(cols[i].className == 'date') { date = ` . ($PREF{show_date_column_in_filelist} =~ /no/i ? qq`'
$TEXT{Date}: ' + children[j].nodeValue + '
'` : qq`''`) . qq`; } } } } div.innerHTML += size + date; if(!div.innerHTML) { div.innerHTML += '$TEXT{_none_}'; } //div.innerHTML += "$TEXT{_Close_Menu_}"; window.setTimeout("set_body_closeoptsmenu()", 500); } function set_body_closeoptsmenu() { old_document_body_onclick = document.body.onclick; document.body.onclick = closeoptsmenu; } function closeoptsmenu() { if(document.getElementById("theoptsmenu")) { document.body.removeChild(document.getElementById("theoptsmenu")); document.body.onclick = old_document_body_onclick; return true; } } function set_itemaction_highlights() { var list = document.getElementById("filelist") ? document.getElementById("filelist") : document.getElementById("filegrid") if(list) { var filelist_inputs = list.getElementsByTagName("input"); var i = 0; for(i = 0; i < filelist_inputs.length; i++) { if(filelist_inputs[i].className.indexOf('itemaction') != -1) { filelist_inputs[i].onchange = setbghighlight; filelist_inputs[i].onclick = setbghighlight; // IE is garbage. } } } } function setbghighlight() { var p = this.parentNode.parentNode; if(this.checked) { p.style.background = '$PREF{filelist_row_highlight_bgcolor}'; p.onmouseover = ''; p.onmouseout = ''; } else { if(document.getElementById("filelist")) { p.onmouseover = setbg; unsettext(p); if(p.className.indexOf('odd') != -1) { p.style.background = '$PREF{filelist_row_normal_bgcolor_odd}'; p.onmouseout = unsetbgodd; } else { p.style.background = '$PREF{filelist_row_normal_bgcolor_even}'; p.onmouseout = unsetbgeven; } } else // filegrid. { p.style.background = ''; } } } function set_row_mouseovers() { if(document.getElementById("filelist")) { var filelist_rows = document.getElementById("filelist").getElementsByTagName("tr"); for(i = 0; i < filelist_rows.length; i++) { var r = filelist_rows[i]; if(r.className.indexOf('even') != -1) { r.onmouseover = setbg; r.onmouseout = unsetbgeven; } else if(r.className.indexOf('odd') != -1) { r.onmouseover = setbg; r.onmouseout = unsetbgodd; } } } } function setbg() { this.style.background = '$PREF{filelist_row_hover_bgcolor}'; ` . (high_contrast_filelist_enabled() ? qq` var tds = this.getElementsByTagName("td"); var i = 0; for(i = 0; i < tds.length; i++) { tds[i].style.color = '$PREF{filelist_row_hover_text_color}'; if(tds[i].getElementsByTagName("a")) { var links = tds[i].getElementsByTagName("a"); var j = 0; for(j = 0; j < links.length; j++) { links[j].style.color = '$PREF{filelist_row_hover_link_color}'; } } } ` : '') . qq` } function unsetbgeven() { this.style.background = '$PREF{filelist_row_normal_bgcolor_even}'; ` . (high_contrast_filelist_enabled() ? qq`unsettext(this);` : '') . qq` } function unsetbgodd() { this.style.background = '$PREF{filelist_row_normal_bgcolor_odd}'; ` . (high_contrast_filelist_enabled() ? qq`unsettext(this);` : '') . qq` } function unsettext(myself) { var tds = myself.getElementsByTagName("td"); var i = 0; for(i = 0; i < tds.length; i++) { tds[i].style.color = '$PREF{filelist_row_normal_text_color}'; if(tds[i].getElementsByTagName("a")) { var links = tds[i].getElementsByTagName("a"); var j = 0; for(j = 0; j < links.length; j++) { links[j].style.color = '$PREF{filelist_row_normal_link_color}'; } } } } function autofill_human_test() { var htfield = document.getElementById("fcht2"); if(htfield) { htfield.value = '$PREF{humantest_code}'; } } var serial_request = false; function set_form_serial_number() { var url_to_get = '$ENV{SCRIPT_NAME}?ajax_get_serial'; if(document.getElementById('theuploadform')) { serial_request = new_ajax_request(); if(!serial_request) { alert('Error: could not get serial number; please reload this page.'); return false; } serial_request.onreadystatechange = set_form_serial_number__stage2; serial_request.open('GET', url_to_get, true); serial_request.send(null); } } function set_form_serial_number__stage2() { if(serial_request) { if(serial_request.readyState == 4) { if(serial_request.status == 200) { var rawdata = serial_request.responseText.match(/(.+)<\\/data>/); var new_serial = rawdata[1]; var theform = document.getElementById('theuploadform'); theform.action = theform.action.replace(/serial=\\w+/, 'serial=' + new_serial); } } } } var humantest_request = false; var uploadbutton_text_default = ''; function check_humanity() { var url_to_get = '$ENV{SCRIPT_NAME}?ajax_do_humantest&fcht1=' + document.getElementById("fcht1").value + '&fcht2=' + document.getElementById("fcht2").value; if(document.getElementById('theuploadform')) { humantest_request = new_ajax_request(); if(!humantest_request) { alert('Error: could not run human test.'); return false; } uploadbutton_text_default = document.getElementById("uploadbutton").value; document.getElementById("uploadbutton").value = "$TEXT{Please_wait}"; document.getElementById("uploadbutton").disabled = true; humantest_request.onreadystatechange = check_humanity__stage2; humantest_request.open('GET', url_to_get, true); humantest_request.send(null); } } function check_humanity__stage2() { if(humantest_request) { if(humantest_request.readyState == 4) { if(humantest_request.status == 200) { var rawdata = humantest_request.responseText.match(/(.+)<\\/data>/); if(rawdata[1].match(/passed=true/)) check_humanity__finish(1); else check_humanity__finish(0); } } } } function check_humanity__finish(testsuccess) { document.getElementById("uploadbutton").value = uploadbutton_text_default; document.getElementById("uploadbutton").disabled = false; if(testsuccess) do_upload(); else alert("$TEXT{Error__failed_human_test__please_try_again_}"); } function add_file_element() { var firstfile_div = document.getElementById("firstfile"); var newfile_div = firstfile_div.cloneNode(true); newfile_div.id = ''; var newnum = document.getElementById("numfileelements").value; newnum++; if(newnum > $PREF{max_files_allowed}) { alert("$TEXT{The_owner_of_this_site_has_set_the_limit_to} $PREF{max_files_allowed}."); return; } var i = 0; var kids = new Array(); var new_divs = newfile_div.getElementsByTagName("div"); for(i = 0; i < new_divs.length; i++) kids.push(new_divs[i]); var new_inputs = newfile_div.getElementsByTagName("input"); for(i = 0; i < new_inputs.length; i++) kids.push(new_inputs[i]); var new_selects = newfile_div.getElementsByTagName("select"); for(i = 0; i < new_selects.length; i++) kids.push(new_selects[i]); var new_textareas = newfile_div.getElementsByTagName("textarea"); for(i = 0; i < new_textareas.length; i++) kids.push(new_textareas[i]); var new_labels = newfile_div.getElementsByTagName("label"); for(i = 0; i < new_labels.length; i++) kids.push(new_labels[i]); var new_spans = newfile_div.getElementsByTagName("span"); for(i = 0; i < new_spans.length; i++) kids.push(new_spans[i]); for(i = 0; i < kids.length; i++) { if(kids[i].name == 'uploadname1') { kids[i].id = 'uploadname' + newnum; kids[i].name = 'uploadname' + newnum; kids[i].value = ''; kids[i].className = kids[i].className.replace(/required/, ''); } else if(kids[i].name == 'subdir1') kids[i].name = 'subdir' + newnum; else if(kids[i].name == 'newsubdir1') kids[i].name = 'newsubdir' + newnum; else if(kids[i].className == 'filei') kids[i].innerHTML = newnum; else if(kids[i].name && kids[i].name.match(/\\w+1\$/)) // for perfile formfields. { kids[i].name = kids[i].name.replace(/1\$/, newnum); kids[i].value = ''; if(kids[i].id && kids[i].id.match(/\\w+1\$/)) { kids[i].id = kids[i].id.replace(/1\$/, newnum); } } } if((newnum % 2)==0) newfile_div.className = newfile_div.className.replace(/odd/, 'even'); newfile_div.className = newfile_div.className.replace(/first/, ''); // the new one isn't first... firstfile_div.className = firstfile_div.className.replace(/last/, ''); // ...and now the first one isn't last anymore. document.getElementById("numfileelements").value = newnum; document.getElementById("numitems").value = newnum; firstfile_div.parentNode.appendChild(newfile_div); var spans = document.getElementById("filefields").getElementsByTagName("span"); for(i = 0; i < spans.length; i++) { if(spans[i].className == 'fileitotal') spans[i].innerHTML = newnum; } } var mouseX = 0; var mouseY = 0; function getMousePosition(event) { var mouseX = window.event ? window.event.clientX : event.pageX; var mouseY = window.event ? window.event.clientY : event.pageY; //document.getElementById("title").innerHTML = mouseX + ' ' + mouseY; } function mouse_coords_init() { document.onmousemove = getMousePosition; } function get_random_text() { var now = new Date(); var time = (now.getTime() - now.getMilliseconds()) / 1000; var ms = now.getMilliseconds(); var ua = navigator.userAgent; var sw = screen.width; var sh = screen.height; var rand = Math.random(); var mime = navigator.mimeTypes; var mimestring = ''; for(var i=0; i>2] >> ((3 - i%4)*8+4)) & 0xF) + hex_tab.charAt((binarray[i>>2] >> ((3 - i%4)*8 )) & 0xF); } return str; } //////////////////////////////////////////////////////////// End SHA-1 code. function schedule_onload_action(newfunc) { var already_scheduled = window.onload; if(typeof window.onload != 'function') { window.onload = newfunc; } else { window.onload = function() { already_scheduled(); newfunc(); } } } schedule_onload_action(mouse_coords_init); //schedule_onload_action(set_form_serial_number); schedule_onload_action(autofill_human_test); schedule_onload_action(set_row_mouseovers); schedule_onload_action(set_itemaction_highlights); schedule_onload_action(generate_new_serial_number); schedule_onload_action(start_juststatus); $PREF{custom_js_code} `; return $js; } sub get_css { my $css = qq` /* html { min-height: 100%; margin-bottom: 1px; } /* /* so #viewpath doesn't shift in FF when there's no scrollbar. -- update 200703: no longer needed since #viewpath is inside the table now. */ #fcbody { background: #ddd; font-family: sans-serif; font-size: 9pt; text-align: center; } .popupstatusbody { background: #fff !important; } #fcbody dl { margin: 0 0 1em; padding: 0; } #fcbody dt, dd { margin: 0; padding: 0; } #pb { margin: 14px auto 2px auto; padding: 3px; } #pb a { color: #000; } #pb a:hover { color: #aaa; } #pb { position: absolute; left: -8000px; } #fcfooter { color: #8b8f8b; margin: 24px auto 4px auto; font-size: 8pt; } /* #uploaderpage, #filelistpage, #defaultpage etc, are the outer containers for their respective pages. */ #uploaderpage, #uploadcompletepage, #filelistpage, #defaultpage { width: 700px; margin: 15px auto; background: white; border: 1px solid #999; padding: 10px; } #uploaderpage #title, #popupstatuspage #title, #uploadcompletepage #title, #filelistpage #title, #defaultpage #title { font-size: 200%; font-weight: bold; padding: 8px; } #uploaderpage, #uploadcompletepage { width: 750px; } #uploaderpage #intro { text-align: justify; } #popupstatuspage { padding: 0; margin: 0 auto; } #specialnote { font-weight: bold; } #fc-container { padding: 8px 12px; } /* this is the whole page except for title and pb */ #fc-container a { color: #507090; } #fc-container a:hover { color: #aaa; } /* #progBarContainer includes everything (progress bar, text, table); #theMeter includes just the bar and the text (percent and rate) */ #progBarContainer { padding-top: 10px; } #progBar, #progBarText { width: $PREF{progress_bar_width}px; } #progBar { margin: 2px auto; height: 20px; border: 1px inset; background: #eee; text-align: left; } #progBarDone { width: 0; height: 20px; border-right: 1px solid #444; background: #507090; background: #4a6695 url($PREF{path_to_filelist_images}pb-bg-02.png) repeat-x; } #theMeter { margin-bottom: 20px; } #uploadCompleteMsg { width: $PREF{progress_bar_width}px; margin: 0 auto 20px; } #progBarContainer table { width: $PREF{progress_bar_width}px; margin: 4px auto 20px auto; text-align: right; border-collapse: collapse; border: 0; border-bottom: 1px solid #bbb;} #progBarContainer table td { border-top: 1px solid #bbb; text-align: center; } #progBarContainer #upload-row-1, #progBarContainer #upload-row-3 { background: #e6e6e6; } #progBarContainer #upload-row-2, #progBarContainer #upload-row-4 { background: #efefef; } #progBarText { font-size: 90%; margin: 1px auto; white-space: nowrap; } #progRate { float: left; text-align: left; width: 19%; } #progStatus { float: left; text-align: center; width: 70%; font-style: italic; } #progPercent { float: right; text-align: right; width: 10%; } #uploadsummary { margin-top: 20px; margin-bottom: 20px !important; } #uploadsummary .file { margin-top: 8px; } #uploadsummary dt { font-weight: bold; margin-bottom: 10px; } #uploadstats dt { font-weight: bold; margin-bottom: 10px; } td.headercell { font-weight: bold; } ` . ( ($PREF{using_upload_hook} =~ /yes/i) ? qq`#tca1,#tcb1,#tcc1,#tcd1 { width: 25%; }` . qq`\n#tca2,#donef,#leftf,#totalf { width: 25%; }` . qq`\n#tca3,#dones,#lefts,#totals { width: 25%; }` . qq`\n#tca4,#donet,#leftt,#totalt { width: 25%; }` : qq`#tca1,#tcb1,#tcc1,#tcd1 { width: 33%; }` . qq`\n#tca2,#donef,#leftf,#totalf { position: absolute; left: -10000px; overflow: hidden; height: 0; }` . qq`\n#tca3,#dones,#lefts,#totals { width: 34%; }` . qq`\n#tca4,#donet,#leftt,#totalt { width: 33%; }` ) . qq` #viewpath { white-space: nowrap; background: #efefef; margin: 0 auto 0 auto; padding: 0px 4px 0px 4px; } #viewpath-outer { padding: 6px; } /* #viewpath-inner { border: 1px solid #000; } */ #viewpath-text { text-align: left; float: left; width: 61%; margin-top: 2px; } #filelist #viewpath-text a { display: inline; } div#optmenutop { text-align: right; float: right; width: 29%; } #optmenutop select, #optmenutop input { margin: 0; padding: 0; vertical-align: middle; font-size: 85%; } .actionrow .controls select, .actionrow .controls input { margin: 0; padding: 0; vertical-align: middle; font-size: 85%; } /* form#optionstop, form#optionsbottom { display: inline; margin: 0; padding: 0; } */ #optmenutop optgroup, #optmenubottom optgroup { font-weight: bold; font-style: normal; } #optmenutop option, #optmenubottom option { padding-left: 20px; } #filelist { text-align: left; border-collapse: collapse; margin: 0 auto 2px auto; border: 1px solid #444; width: 670px; } #filelist tr { border: 0px solid white; } #filelist tr.even { background: $PREF{filelist_row_normal_bgcolor_even}; } #filelist tr.odd { background: $PREF{filelist_row_normal_bgcolor_odd}; } /* Add these to replace the JS-based row mouseovers: #filelist tr.odd:hover, #filelist tr.even:hover { background: #507090; color: #fff; } #filelist tr.odd:hover a, #filelist tr.even:hover a { color: #fff; } */ #filelist td { } #filelist td#viewpath-cell { padding: 0; } #filelist td#viewpath-cell a { text-decoration: underline; } #filelist a:link { color: $PREF{filelist_row_normal_link_color}; text-decoration: none; display: block; width: 100%; padding: 4px 2px; } #filelist a:visited { color: $PREF{filelist_row_visited_link_color}; text-decoration: none; display: block; width: 100%; padding: 4px 2px; } #filelist a:hover { color: $PREF{filelist_row_hover_link_color}; } #filelist .emptytable { text-align: center; font-style: italic; padding: 4px; } #filelist td.pname { background: url($PREF{path_to_filelist_images}fcarrow.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.fname { background: url($PREF{path_to_filelist_images}fcfile.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.diricon { background: url($PREF{path_to_filelist_images}fcfolder.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.homeicon { background: url($PREF{path_to_filelist_images}fchome.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.dname { background-color: inherit; } #filelist td.pname, #filelist td.dname, #filelist td.fname { width: 340px; padding-left: 20px; } /* #filelist td.thumb { background-image: none; } */ #filelist .info, #filelist .mv, #filelist .sel, #filelist .del, #filelist .opt, #filelist .cinfo { text-align: center; } #filelist .size { text-align: right; } #filelist .size { white-space: pre; padding: 4px 10px 4px 2px; } #filelist .date { white-space: pre; padding: 4px 5px; text-align: right; } #filelist .info, #filelist .mv, #filelist .del, #filelist .sel, #filelist .opt, #filelist .cinfo { padding: 0 6px; } #filelist .spc { padding: 0 6px 0 3px; } #filelist .info, #filelist .mv, #filelist .sel, #filelist .mopts, #filelist .del, #filelist .perms { display: none; } #filegrid .info, #filegrid .mv, #filegrid .sel, #filegrid .mopts, #filegrid .del, #filegrid .perms { display: none; } #filelist #infohead, #filelist #mvhead, #filelist #selhead, #filelist #delhead, #filelist #moptshead, #filelist #permshead { display: none; } #filegrid #infohead, #filegrid #mvhead, #filegrid #selhead, #filegrid #delhead, #filegrid #moptshead, #filegrid #permshead { display: none; } .optsmenu { min-width: 90px; max-width: 150px; background: #eee; border: 1px solid #999; color: #000; text-align: left; } .optsmenu a { display: block; text-decoration: none; padding: 5px; color: #000; } .optsmenu div { display: block; padding: 5px; color: #555; white-space: nowrap; font-style: italic; } .optsmenu a:hover { background: #c7c7c7; } #filelist th { text-align: center; padding: 5px 0; font-size: 120%; background: #507090; color: #fff; border-bottom: 1px solid #444; } #filelist #namehead { text-align: left; padding-left: 7px; } #filelist #namehead a, #filelist #sizehead a, #filelist #datehead a { color: #fff; font-weight: bold; } #filegrid { margin: 10px auto; text-align: center; } #filegrid td { width: 33%; padding: 10px; border: 1px solid #fff; } #filegrid td:hover { background: #efefef; border: 1px solid #bbb; } #filegrid a.thumb { display: block; } #filegrid a.icon { display: block; border: 0; } #filegrid img.icon { border: 0; } #filegrid .prnt .info, #filegrid .prnt .size, #filegrid .prnt .mv, #filegrid .prnt .sel, #filegrid .prnt .del { display: none; } #filegrid .dir .info, #filegrid .dir .sel { display: none; } #filegrid td#viewpath-cell a { text-decoration: underline; } #filegrid .pname a:link, #filegrid .dname a:link, #filegrid .fname a:link { color: #000; text-decoration: none; padding: 4px 2px; } #filegrid .pname a:visited, #filegrid .dname a:visited, #filegrid .fname a:visited { color: #000; text-decoration: none; padding: 4px 2px; } #filegrid .pname a:hover, #filegrid .dname a:hover, #filegrid .fname a:hover { color: #000; text-decoration: underline; } #filegrid .date, #filegrid .size { font-size: 90%; color: #676767; } #filegrid .emptytable { text-align: center; font-style: italic; padding: 4px; } form#itemactions { margin: 0; padding: 0; } #filelist .actionrow a:link, #filelist .actionrow a:visited, #filegrid .actionrow a:link, #filegrid .actionrow a:visited { text-decoration: none; display: inline; width: auto; padding: 0; margin: 0; } td.actionrow { padding: 6px; text-align: right; vertical-align: middle; white-space: nowrap; } #filegrid { width: 100%; } .actionrow .sizeinfo { float: left; text-align: left; padding-left: 5px; margin-top: 2px; } .actionrow .links { float: right; text-align: right; padding-right: 10px; margin-top: 2px; width: 20%; } .actionrow .controls { float: right; text-align: right; padding-right: 5px; padding-left: 8px; } .actionrow a.toggle-counts { text-decoration: underline !important; } #fcinfo { border-collapse: collapse; border: 1px solid #ccc; background: #efefef; padding: 3px; } #fcinfo tr:hover { background: #e0e0e0; } #fcinfo td { border-top: 1px solid #ccc; padding: 4px; } #fcinfo .spacer { height: 25px; } #fcinfo .f { text-align: left; width: 50%; font-weight: bold; } #fcinfo .v { text-align: left; } #fcinfo .h { text-align: left; font-size: 16pt; font-weight: bold; } #setfilecount_wrapper { margin: 15px 0 12px 0; } #theuploadform { } #filefields { border-top: 1px solid #ccc; border-bottom: 1px solid #ccc; border: 1px solid #ccc; /* background: #e3e3e3; */ } #filefields .even { background: #eee; } #filefields .odd { /* background: #e3e3e3; */ } .fileelement { margin-bottom: 5px; } .onesubgroup { padding: 15px 0 10px 0; } .onesubgroup div { margin-bottom: 5px; } .onesubgroup label { display: inline; font-size: 100%; } /* we're centered by default, so we don't need the floats and clearfix-filefield stuff; just inline it. */ #addanotherfile { margin-top: 15px; } #uploadbutton { margin: 14px 0 6px 0; } .uploader-comments { text-align: left; border: 1px solid #e0e0e0; padding: 4px; } #fcbody .hr { height: 1px; border-bottom: 1px solid #000; margin: 15px 2px; line-height: 1px; } #fcbody h1, #fcbody h2, #fcbody h3, #fcbody h4, #fcbody h5, #fcbody h6 { margin-top: 5px; margin-bottom: 5px; } #fcbody form { margin: 0; padding: 0; } #fcbody p { margin-top: 10px; margin-bottom: 10px; } .comments textarea { width: 300px; height: 50px; } #top-textboxes, #perfile-textboxes, #bottom-textboxes, #specialnote, #fc-humantest { margin: 25px 0; padding: 5px; border: 1px solid #ccc; } #top-textboxes div, #perfile-textboxes div, #bottom-textboxes div { margin: 7px 2px; } #top-textboxes-title, #perfile-textboxes-title, #bottom-textboxes-title, #setfilecount_title, #choosefiles_title { font-size: 110%; font-weight: bold; } #setfilecount_title { margin-bottom: 8px; } #choosefiles_title { margin-top: 10px; } #perfile-textboxes { margin: 8px 20px; } .textboxes-label { float: left; width: 47%; text-align: right; margin-top: 3px !important; } .radiobox { margin-top: 3px !important; } #top-textboxes input.textfield, #top-textboxes textarea, #top-textboxes .radiobox, #perfile-textboxes input.textfield, #perfile-textboxes textarea, #perfile-textboxes .radiobox, #bottom-textboxes input.textfield, #bottom-textboxes textarea, #bottom-textboxes .radiobox { float: left; width: 37%; display: block; } #top-textboxes select, #perfile-textboxes select, #bottom-textboxes select { float: left; } #selections_table { border-collapse: collapse; border: 1px solid #9a9a9a; margin: 15px auto; text-align: left; } #selections_table .odd { background: #e6e6e6; } #selections_table .even { background: #efefef; } #selections_table td { padding: 4px 4px 4px 20px; background: url($PREF{path_to_filelist_images}fcfile.gif) 1% 50% no-repeat; } #place_order { text-align: center; } #theorderform { width: 300px; margin: 0 auto; padding: 3px; text-align: left; border: 1px solid #999; background: #e6e6e6; } #theorderform .text { width: 150px; margin: 5px; padding: 3px; border: 1px solid #676767; } #theorderform .submit input { margin: 5px; } #itemperms { border-collapse: collapse; border: 1px solid #bbb; text-align: center; margin: 10px auto; color: #575757; width: 90%; } #itemperms th { background: #507090; color: #fff; padding: 12px; font: bold 16pt sans-serif; } #itemperms .heading td { background: #83B96B; color: #fff; padding: 4px; font: bold 10pt sans-serif; } #itemperms td { padding: 2px; } #itemperms td.name { text-align: left; } #itemperms td.path { text-align: left; } #itemperms td.none { text-align: left; font-style: italic; } #itemperms td.ro, #itemperms td.rw { text-align: left; padding-left: 80px; white-space: nowrap; } #itemperms tr.odd { background: #e9e9e9; } #itemperms tr.even { background: #efefef; } #itemperms a { color: #000; } #itemperms tr:hover { background: #83B96B; color: #fff; } #itemperms tr:hover a { color: #fff; text-decoration: underline; } #itemperms tr:hover a:hover { color: #000; } .itemperms-letters { font-size: 120%; font-weight: bold; } #fc-container .itemperms-letters a { padding: 4px; color: #507090; text-decoration: none; } #fc-container .itemperms-letters a:hover { background: #507090; color: #fff; } #fc-container .itemperms-letters a.current { text-decoration: underline; } #itemperms .button { margin: 10px; } .footnote { font: italic 9pt sans-serif; color: #888; margin: 5px 40px; } .clear { height: 0; line-height: 0; font-size: 0; clear: both; } .clearfixtb:after { content: "."; display: block; height: 0; clear: both; visibility: hidden; } .clearfixtb { display: inline-block; } /* Hides from IE-mac \*/ * html .clearfixtb {height: 1%;} .clearfixtb {display: block;} /* End hide from IE-mac */ .clearfix:after { content: "."; display: block; height: 0; clear: both; visibility: hidden; } .clearfix { display: inline-block; } /* Hides from IE-mac \*/ * html .clearfix {height: 1%;} .clearfix {display: block;} /* End hide from IE-mac */ `; my %styles = (); $styles{light} = qq` #filelist tr.actionrow { background: #507090; color: #fff; } #filelist td.actionrow { border-top: 1px solid #444; } #filelist .actionrow a:link { color: #fff; } #filelist .actionrow a:visited { color: #fff; } #filelist .actionrow a:hover, #filelist .actionrow a:visited:hover { color: #000; } #filelist td#viewpath-cell a { color: #507090; } #filelist td#viewpath-cell a:hover { color: #aaa; } #filegrid td#viewpath-cell { background: #efefef; border: 1px solid #bbb; padding: 2px; } #filegrid td.actionrow { background: #efefef; border: 1px solid #bbb; } `; $styles{light_ie} = qq` `; $styles{big} = qq` /* big blocky style: */ #filelist a:link, #filelist a:visited { } #filelist th, #filelist td { padding: 10px 6px; } #filelist th { font-size: 140%; } #filelist td.pname { background: url($PREF{path_to_filelist_images}fcarrowbig.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.dname { background: url($PREF{path_to_filelist_images}fcfolderbig.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.fname { background: url($PREF{path_to_filelist_images}fcfilebig.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.pname, #filelist td.dname, #filelist td.fname { width: 350px; padding-left: 15px; } #filelist td.pname a:link, #filelist td.dname a:link, #filelist td.fname a:link, td.pname, #filelist td.pname a:visited { color: black; font-size: 14px; font-weight: bold; text-decoration: none; } #filelist td.dname a:visited, #filelist td.fname a:visited { color: #000; font-size: 14px; font-weight: bold; text-decoration: none; } #filelist td.pname a:hover, #filelist td.dname a:hover, #filelist td.fname a:hover { } #filelist td.dname { padding-top: 12px; padding-bottom: 8px; } #filelist tr.actionrow { background: #507090; color: #fff; } #filelist td.actionrow { border-top: 1px solid #444; } #filelist .actionrow a:link { color: #fff; } #filelist .actionrow a:visited { color: #fff; } #filelist .actionrow a:hover, #filelist .actionrow a:visited:hover { color: #000; } #filelist td#viewpath-cell a { color: #507090; } #filelist td#viewpath-cell a:hover { color: #aaa; } #filelist td#viewpath-cell { background: #efefef; padding: 2px; } #filegrid td#viewpath-cell { background: #efefef; border: 1px solid #bbb; padding: 2px; } #filegrid td.actionrow { background: #efefef; border: 1px solid #bbb; } `; $styles{big_ie} = qq` `; $styles{dark} = qq` #fcbody { background: #434343; color: #fff; } #title { padding-top: 10px !important; color: #fff; } #intro { margin: 0 7px; } #fc-container a { color: #ccc; } #fc-container a:hover { color: #000; } #uploaderpage, #uploadcompletepage, #filelistpage, #defaultpage { background: #5a775a; border: 0px; padding: 0; padding-bottom: 10px; } #fc-container { padding: 0; margin: 0; } #uploaderpage { width: 600px; padding-top: 12px; } #uploadbuttonwrapper { margin: 15px 5px; } #progBarContainer table { color: #fff; background: #424242; border-top: 1px solid #000; border-left: 1px solid #000; border-bottom: 1px solid #fff; border-right: 1px solid #fff; } #progBarContainer #upload-row-1, #progBarContainer #upload-row-3 { background: #545454; } #progBarContainer #upload-row-2, #progBarContainer #upload-row-4 { background: #545454; } #progBarContainer table td#tca1,#progBarContainer table td#tca2,#progBarContainer table td#tca3,#progBarContainer table td#tca4 { border-top: 0; } #dones,#lefts,#totals,#donef,#leftf,#totalf,#donet,#leftt,#totalt { border-top: 1px solid #676767; } #progBar { background: #6a6a6a; border-top: 1px solid #000; border-left: 1px solid #000; border-bottom: 1px solid #fff; border-right: 1px solid #fff; } #progBarDone { border-right: 1px solid #000; background: #993333; } #filefields { background: #333; background: transparent; color: #000; margin: 0px 20px; border: 1px solid #393939; } #filefields .even { background: #5a6d5a; } #filefields div { margin-top: 8px; margin-bottom: 12px; } .onesubgroup { padding: 3px 0; } #top-textboxes, #perfile-textboxes, #bottom-textboxes { margin: 25px 20px; padding: 5px; border: 1px solid #393939; } table#filelist { color: $PREF{filelist_row_normal_text_color}; border: 1px solid #333; border-bottom: 1px solid #333; margin: 0 auto 20px auto; } #filelist th { background: #333; border-bottom: 0px solid #000; } #filelist td { border-top: 1px solid #676767; } #filelist a:hover { color: #fff; } #filelist td#viewpath-cell { border-top: 0; border-bottom: 1px solid #676767; padding: 0; } #filelist td#viewpath-cell a:hover { color: #000; } #viewpath { background: $PREF{filelist_row_normal_bgcolor_even}; } #filegrid { width: 95%; } #filegrid { border-collapse: collapse; } #filegrid td { border: 0; } #filegrid td:hover { border: 0; background: #648564; } #filegrid .date, #filegrid .size { font-size: 90%; color: #fff; } #filegrid td.actionrow { background: $PREF{filelist_row_normal_bgcolor_even}; border: 1px solid #333; } #filegrid td#viewpath-cell { background: $PREF{filelist_row_normal_bgcolor_even}; border: 1px solid #333; padding: 3px; } #filelist tr.actionrow { background: #333; } #filelist td.actionrow { border-top: 1px solid #444; } #filelist .actionrow a:link { color: #fff; } #filelist .actionrow a:visited { color: #fff; } #filelist .actionrow a:hover, #filelist .actionrow a:visited:hover { color: #000; } #filelist td.actionrow { background: #333; border: 1px solid #333; } #fcfooter { background: #333; margin-top: 0; padding: 10px 4px; } #fcfooter a { color: #fff; text-decoration: none; font-weight: bold; } #fcfooter a:hover { color: #aa3333; } `; $styles{dark_ie} = qq` `; $styles{darker} = qq` #fcbody { background: #434343; color: #fff; } #title { color: #fff; } #fc-container a { color: #aaa; } #fc-container a:hover { color: #fff; } #uploaderpage, #uploadcompletepage, #filelistpage, #defaultpage { background: #575757; border: 0; border-top: 1px solid #fff; border-left: 1px solid #fff; border-bottom: 1px solid #000; border-right: 1px solid #000; } #progBarContainer table { color: #fff; background: #424242; border-top: 1px solid #000; border-left: 1px solid #000; border-bottom: 1px solid #fff; border-right: 1px solid #fff; } #progBarContainer #upload-row-1, #progBarContainer #upload-row-3 { background: #424242; } #progBarContainer #upload-row-2, #progBarContainer #upload-row-4 { background: #4a4a4a; } #progBarContainer table td { border: 0; } #progBar { background: #424242; border-top: 1px solid #000; border-left: 1px solid #000; border-bottom: 1px solid #fff; border-right: 1px solid #fff; } #progBarDone { border-right: 1px solid #444; background: #4a774a; } #filefields { border: 0px solid #393939; background: #4a774a; color: black; border-top: 1px solid #000; border-left: 1px solid #000; border-bottom: 1px solid #fff; border-right: 1px solid #fff; } #filefields div { margin-top: 8px; margin-bottom: 12px; } table#filelist { border: 0px solid #000; color: $PREF{filelist_row_normal_text_color}; border-top: 1px solid #000; border-left: 1px solid #000; border-bottom: 1px solid #fff; border-right: 1px solid #fff; } #filelist th { background: #437743; border-bottom: 0px solid #000; } /* input,select { background: #000; color: #fff; border: 2px inset #fff; } */ `; $styles{minimal} = qq` /* minimal style: */ #fcbody { background: #fff; font-family: serif; } #uploaderpage, #uploadcompletepage, #filelistpage, #defaultpage { border: 0; } #filelistpage #title { position: absolute; left: -10000px; } #fcfooter { color: #555; } #fcfooter a { color: #000; } #fcfooter a:hover { color: #507090; } #pb a { color: #737373; } #pb a:hover { color: #000; } #uploader { background: #fff; border: 0; } #filelist { border: 1px dashed #bbb; border-left: 0; border-right: 0; } #filelist tr { border-top: 1px dashed #bbb; } #filelist tr.even { background: $PREF{filelist_row_normal_bgcolor_even}; background: #fff; } #filelist tr.odd { background: $PREF{filelist_row_normal_bgcolor_odd}; background: #fff; } #filelist a:link, #filelist a:visited { } #filelist th, #filelist td { padding: 1px 6px; font-size: 0.8em; } #filelist th { font-size: 0.9em; color: #000; background: #fff; border-bottom: 0; } #filelist #namehead a, #filelist #sizehead a, #filelist #datehead a { color: #000; } #filelist td.pname { background: url($PREF{path_to_filelist_images}fcarrow.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.dname { background: url($PREF{path_to_filelist_images}fcfolder.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.fname { background: url($PREF{path_to_filelist_images}fcfile.gif) 1% 50% no-repeat; background-color: inherit; } #filelist td.pname, #filelist td.dname, #filelist td.fname { width: 350px; padding-left: 18px; } #filelist td.pname a:link, #filelist td.dname a:link, #filelist td.fname a:link, td.pname, #filelist td.pname a:visited { color: black; text-decoration: none; } #filelist td.dname a:visited, #filelist td.fname a:visited { color: #555; text-decoration: none; } #filelist td.pname a:hover, #filelist td.dname a:hover, #filelist td.fname a:hover { } td.size { color: #444; } td.date { color: #444; } `; $styles{round} = qq` /* round style: */ #uploaderpage, #uploadcompletepage, #filelistpage, #defaultpage { padding: 0; border: 0; } #fcbody { background: #e3e3e3; } #fcc1 { background: url($PREF{path_to_filelist_images}fcc-TL-e3e3e3.png) top left no-repeat; } #fcc2 { background: url($PREF{path_to_filelist_images}fcc-TR-e3e3e3.png) top right no-repeat; } #fcc3 { background: url($PREF{path_to_filelist_images}fcc-BR-e3e3e3.png) bottom right no-repeat; } #fcc4 { background: url($PREF{path_to_filelist_images}fcc-BL-e3e3e3.png) bottom left no-repeat; } #title img { margin: 10px auto 0px auto; } #uploaderpage #title, #uploadcompletepage #title, #filelistpage #title, #defaultpage #title { padding: 10px 1px 1px 1px; color: #53a4cd; } #fc-container, #intro { margin-top: 0px; padding-top: 0px; } #uploaderpage #fcfooter { margin-bottom: 15px; font-size: 8pt; } table#filelist { border: 0px solid #ccc; color: #444; width: 630px; margin: 10px auto 0 auto; } #filelist th { background: #e3e3e3; border: 0; font-size: 90%; padding: 0px; color: #878787; } #filelist #namehead a, #filelist #sizehead a, #filelist #datehead a { color: #878787; font-weight: bold; } #filelist td { border-top: 1px solid #ddd; font-size: 8.5pt; } #filelist td.actionrow { background: #e3e3e3; border-bottom: 1px solid #ddd; } #filelist td.actionrow a:hover { color: #888; } #filelist td#viewpath-cell { border-top: 0; border-bottom: 1px solid #ddd; background: transparent; padding: 0; } #filelist td#viewpath-cell a:hover { color: #53a4cd; text-decoration: underline; } #filegrid { margin: 10px auto 0 auto; border-collapse: collapse; background: #efefef; width: 630px; } #filegrid td { border: 0; } #filegrid td:hover { border: 0; background: #e6e6e6; } #filegrid td.actionrow { background: #e3e3e3; border-top: 1px solid #bbb; border-bottom: 1px solid #bbb; } #filegrid td.actionrow .links a { font-size: 8pt; } #filegrid td#viewpath-cell { border-top: 0; border-bottom: 1px solid #bbb; background: transparent; padding: 0; } #viewpath { background: #efefef url($PREF{path_to_filelist_images}fcc-TL-efefef.png) top left no-repeat; color: #53a4cd; margin: 0px auto 0px auto; text-align: left; border: 0; padding: 0; font-size: 8.5pt; } #viewpath-outer { padding: 0; } #viewpath-inner { background: url($PREF{path_to_filelist_images}fcc-TR-efefef.png) top right no-repeat; } #viewpath-text { padding: 10px 5px 10px 15px; font-size: 110%; font-weight: bold; font-family: Tahoma, Arial, sans-serif; letter-spacing: 1px; } #optmenutop { padding: 12px 15px 10px 5px; font-size: 10pt; } #filelistpage #fcfooter { background: #efefef url($PREF{path_to_filelist_images}fcc-BR-efefef.png) bottom right no-repeat; color: #444; margin: 0px auto 10px auto; width: 630px; font-size: 8pt; } #filelistpage #fcfooter-inner { background: url($PREF{path_to_filelist_images}fcc-BL-efefef.png) bottom left no-repeat; width: 630px; } #filelistpage #fcfooter-text { padding: 14px; } #fc-container a { font-weight: bold; } #fc-container #fcfooter a { color: #65c460; text-decoration: none; font-size: 10pt; } #fc-container #fcfooter a:hover { background: #65c460; color: white; } `; $css .= "\n\n" . $styles{$PREF{current_filelist_style}} . "\n\n"; # Note: any conditional comments must come AFTER custom_css_section. $css .= qq` $PREF{custom_css_section} ` . qq`\n` . $PREF{extra_header_output} . qq`\n` . qq`\n`; } elsif($PREF{default_sitewide_header_file} && -e $PREF{default_sitewide_header_file}) { open(HEADERFH, "<$PREF{default_sitewide_header_file}") or die "$0: couldn't open \$PREF{default_sitewide_header_file} ('$PREF{default_sitewide_header_file}') for reading:: $!\n"; my $infh = \*HEADERFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". flock $infh, 1; seek $infh, 0, 0; while(<$infh>) { s!%%title%%!$title!g; s!%%js%%!!g; s!%%css%%!!g; print $_; } close $infh or die "$0: couldn't close \$PREF{default_sitewide_header_file} ('$PREF{default_sitewide_header_file}') after reading:: $!\n"; print $PREF{extra_header_output}; print qq`$PREF{outer_container}\n`; } else { print $PREF{extra_header_output}; print qq`$PREF{outer_container}\n`; } print qq`$PREF{title}\n` if ($PREF{title} && $PREF{title_inside_perpage_container} !~ /yes/i); print qq`$PREF{perpage_container}\n`; # this is #uploaderpage, #filelistpage, #defaultpage, etc. print qq`$PREF{title}\n` if ($PREF{title} && $PREF{title_inside_perpage_container} =~ /yes/i); print qq`$PREF{inner_container}\n`; } sub finish_html_output { return if $PREF{finish_html_output_called}; $PREF{finish_html_output_called} = 1; print_footer_links(@_) if (@_ && $PREF{footer_inside_perpage_container} =~ /yes/i); print qq`\n$PREF{inner_container_end}\n`; # end fc-container DIV. print_powered_by() unless $PREF{hide_poweredby} =~ /yes/i; print qq`\n$PREF{perpage_container_end}\n`; # end perpage_container DIV (#uploaderpage, #filelistpage, #defaultpage, etc). print_footer_links(@_) if (@_ && $PREF{footer_inside_perpage_container} !~ /yes/i); if(($qs =~ /debug/) && ($PREF{debug})) { my %perms = (); my ($curdir) = ($ENV{SCRIPT_NAME} =~ m!^(.*)/!); $perms{1}{item} = $ENV{SCRIPT_NAME}; $perms{1}{required} = '0755'; $perms{1}{actual} = sprintf "%04o", ((stat( "$PREF{DOCROOT}/$ENV{SCRIPT_NAME}" ))[2] & $PREF{writable_dir_perms_mask_as_octal}); $perms{2}{item} = $PREF{datadir}; $perms{2}{required} = $PREF{writable_dir_perms_as_string}; $perms{2}{actual} = sprintf "%04o", ((stat( "$PREF{datadir}" ))[2] & $PREF{writable_dir_perms_mask_as_octal}); $perms{3}{item} = $PREF{uploaded_files_realpath}; $perms{3}{required} = $PREF{writable_dir_perms_as_string}; $perms{3}{actual} = sprintf "%04o", ((stat( "$PREF{uploaded_files_realpath}" ))[2] & $PREF{writable_dir_perms_mask_as_octal}); print qq`\n\n\n\n`; } # # print qq`` # . qq`\n
` # . qq`\n` # . qq`\n` # . qq`\n` # . qq`\n` # . qq`\n
` # . qq`\n` # . qq`\n`; # if($ENV{REQUEST_METHOD} =~ /post/i || $PREF{"print_full_html_tags_for_$PREF{on_page}"} =~ /yes/i || ($PREF{print_full_html_tags} =~ /yes/i && $PREF{"print_full_html_tags_for_$PREF{on_page}"} !~ /no/i)) { print $PREF{extra_footer_output}; print qq`\n\n`; } elsif($PREF{default_sitewide_footer_file} && -e $PREF{default_sitewide_footer_file}) { print qq`$PREF{outer_container_end}\n`; print $PREF{extra_footer_output}; open(FOOTERFH, "<$PREF{default_sitewide_footer_file}") or die "$0: couldn't open \$PREF{default_sitewide_footer_file} ('$PREF{default_sitewide_footer_file}') for reading:: $!\n"; my $infh = \*FOOTERFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". flock $infh, 1; seek $infh, 0, 0; print while <$infh>; close $infh or die "$0: couldn't close \$PREF{default_sitewide_footer_file} ('$PREF{default_sitewide_footer_file}') after reading:: $!\n"; } else { print qq`$PREF{outer_container_end}\n`; print $PREF{extra_footer_output}; } } sub print_footer_links { my @links = (); while(my $i = shift) { if($i =~ /uploader/) { push @links, qq`$PREF{upload_files_link_label}` if ($PREF{upload_files_link_label} && user_is_allowed_to('upload')); } elsif($i =~ /home/) { push (@links, qq`$PREF{home_link_name}`) if $PREF{home_link_name}; } elsif($i =~ /mkdir/) { if($PREF{enable_subdirs} =~ /yes/i) { push @links, qq`$TEXT{New_Folder}` if display_new_folder_link(); } } elsif($i =~ /selections/) { push @links, qq`$PREF{view_items_page_name}` if display_showcart_link_in_linkbar(); } elsif($i =~ /logout/) { my $go = get_logout_url(); push (@links, qq`$TEXT{Logout}`) if $PREF{member_is_logged_in}; } elsif($i =~ /login/) { my $go = get_login_url(); push (@links, qq`$TEXT{Login}`) if (login_features_enabled() && !$PREF{member_is_logged_in} && $PREF{show_login_link} =~ /yes/i); } elsif($i =~ /list/) { push (@links, qq`$PREF{show_uploads_link_text}`) if ($PREF{show_uploads_link_text} && show_link_to_uploads()); } elsif($i =~ /addfile/) { push (@links, qq`$PREF{label_for_addfile_action}`) if ($PREF{enable_addfile_mode} =~ /yes/i); } } push (@links, @{$PREF{extra_footer_links}}); push (@links, get_powered_by()) unless $PREF{hide_poweredby} =~ /yes/i; if($PREF{on_page} eq 'uploader' && exists $PREF{custom_footer_for_uploader}) { print $PREF{custom_footer_for_uploader}; } elsif($PREF{on_page} eq 'popupstatus' && exists $PREF{custom_footer_for_popupstatus}) { print $PREF{custom_footer_for_popupstatus}; } elsif($PREF{on_page} eq 'uploadcomplete' && exists $PREF{custom_footer_for_uploadcomplete_page}) { print $PREF{custom_footer_for_uploadcomplete_page}; } elsif($PREF{on_page} eq 'filelist' && exists $PREF{custom_footer_for_filelist}) { print $PREF{custom_footer_for_filelist}; } elsif($PREF{on_page} eq 'default' && exists $PREF{custom_footer_for_default_pages}) { print $PREF{custom_footer_for_default_pages}; } else { print qq`$PREF{footer_markup_start}\n`; print join " – ", @links; print qq`$PREF{footer_markup_end}\n`; } } sub print_powered_by { print qq`
\n`; print get_powered_by(); print qq`
\n`; } sub get_powered_by { return qq`File Upload by Encodable`; } sub get_logout_url { return $PREF{integrate_with_userbase} =~ /yes/i || $PREF{integrate_with_existing_login_system} =~ /yes/i ? $PREF{logout_url} : "$ENV{SCRIPT_NAME}?logout"; } sub get_login_url { return $PREF{integrate_with_userbase} =~ /yes/i || $PREF{integrate_with_existing_login_system} =~ /yes/i ? $PREF{login_url} : "$PREF{here_login}?login"; } sub display_new_folder_link() { return user_is_allowed_to('create_folders_thru_filelist') && user_can_write_to_at_least_one_directory(); } sub user_can_write_to_at_least_one_directory() { return ( $PREF{admin_is_logged_in} || ($PREF{enable_userdirs} =~ /yes/i && $PREF{userdir} && $PREF{assume_userdir_means_a_writable_dir_exists} !~ /no/i) || get_all_writable_directories() ); } sub make_qs { my $newqs = ''; my @items = (); foreach my $arg (@_) { if($arg eq 'uploader') { if($PREF{default_page} ne 'uploader') { push @items, 'action=upload'; } } elsif($arg eq 'addfile') { my ($path) = ($qs =~ /(?:^|&)path=(.*?)(?:&|$)/); $path = '/' unless $path; push @items, "addfilemode=on&path=$path"; } } if($PREF{enable_userdirs} =~ /yes/i && $PREF{keep_userdir_on_url} =~ /yes/i) { push @items, "userdir=" . get_userdir(); } if(@items) { for(@items) { $newqs .= $_ . '&'; } $newqs =~ s/&$//; $newqs = "?$newqs"; } return $newqs; } sub get_options_menu { return unless $PREF{show_options_menu} =~ /yes/i; my $pos = shift; # action=itemactions my $form = qq`` #. qq`
` #. qq`\n` . qq`\n` . qq`\n` #. qq`\n
` . qq`\n`; } sub show_files_as_links_on_upload_complete_page { return ( $PREF{upload_complete_page_links_to_files_for_strangers} =~ /yes/i || ($PREF{upload_complete_page_links_to_files_for_members} =~ /yes/i && $PREF{member_is_logged_in}) || ($PREF{upload_complete_page_links_to_files_for_admins} =~ /yes/i && $PREF{admin_is_logged_in}) ); } sub make_dir { my $path = shift || ''; my $dirname = shift; unless(user_is_allowed_to('create_folders_thru_filelist')) { #print_not_allowed_error_and_exit(); exit_with_access_denied(); } enc_urldecode($path, $dirname); $path = enc_untaint($path, 'keep_path') if $path; $dirname = enc_untaint($dirname) if $dirname; clean_up_filename($dirname) if $PREF{clean_up_filenames} =~ /yes/i; remove_reserved_strings($dirname); if($path && $dirname) { exit_with_error("Insufficient permissions on target folder.") unless get_effective_folder_permissions($PREF{logged_in_username}, $path) =~ /^rw$/i; my $num_subdir_levels = 0; my $testpath = "/$path"; while($testpath =~ m!(/|\\)[^/\\]+!g) { $num_subdir_levels++; } if( ($PREF{max_num_of_subdir_levels} !~ /^\d+$/) || ($num_subdir_levels < $PREF{max_num_of_subdir_levels}) ) { my $maxlen = $PREF{max_length_of_new_subdir_names}; $dirname =~ s/^(.{1,$maxlen}).*/$1/; my $fullpath_url = $PREF{hide_path_to_uploads_dir} =~ /yes/i ? "/$path/$dirname" : $PREF{uploaded_files_urlpath} . "/$path/$dirname"; my $fullpath_real = $PREF{uploaded_files_realpath} . "/$path/$dirname"; my $path_urlencoded = "$path/$dirname"; s![/\\]{2,}!/!g for ($fullpath_url, $fullpath_real, $path_urlencoded); enc_urlencode($path_urlencoded); my $userdir = get_userdir_for_qs(); # A lame superfluous test, needed on some 1&1 servers (DD). # if(-e $fullpath_real) { start_html_output('New Folder', 'css'); print qq`

Folder Exists

` . qq`\n

Folder $fullpath_url exists.

` . qq`\n`; finish_html_output('home','uploader','list'); } else { if(mkdir($fullpath_real,$PREF{writable_dir_perms_as_octal}) && chmod($PREF{writable_dir_perms_as_octal},$fullpath_real)) { start_html_output('Creating...', 'css'); print qq`

New Folder Created Successfully:

` . qq`\n

$fullpath_url

` . qq`\n`; finish_html_output('home','uploader','list'); } else { die_nice(qq`Error: couldn't create directory "$fullpath_url": $!`); } } } else { die_nice(qq`Error: couldn't create directory: sublevel limit ($num_subdir_levels) would be exceeded.`); } } else { my $hidden_userdir_input = $PREF{enable_userdir_on_url} =~ /yes/i && $PREF{keep_userdir_on_url} =~ /yes/i ? qq`` : ''; start_html_output('Make New Directory', 'css'); print qq`

Make New Directory

\n

Location:

` . qq`\n
` . qq`\n` . $hidden_userdir_input . qq`\n
` . qq`\n` . qq`\n

Name:

` . qq`\n
` . qq`\n


` . qq`\n
` . qq`\n`; finish_html_output('home','uploader','list'); } } sub delete_items($) { my $query = new CGI(); # must happen, or there's a weird delay between client/server after the script finishes. my %params = $query->Vars; exit_with_error("Error: access denied.") unless user_is_allowed_to('delete_items'); my ($path) = @_; enc_urldecode($path); foreach my $param(sort keys %params) { #print "$param: $params{$param}
\n"; if(my ($itemtype,$filename) = ($param =~ /^(file|dir)-(.+)/)) { $itemtype = 'folder' if $itemtype eq 'dir'; delete_item($path, $itemtype, $filename, 'really', 'batchmode'); } } enc_redirect($ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here}?action=listfiles"); } sub delete_item { my $path = shift; my $itemtype = shift; # 'file' or 'folder'. my $name = shift; my $really = shift; my $batchmode = shift; unless(user_is_allowed_to('delete_items')) { #print_not_allowed_error_and_exit(); exit_with_access_denied(); } enc_urldecode($path, $name); my $displayname = $name; enc_urldecode($displayname); if($displayname =~ /(\d{15,})(\..{1,6})$/) { my ($to_replace,$end) = ($1,$2); my ($replacement) = ($to_replace =~ /^(\d{12})/); $displayname =~ s/$to_replace$end/$replacement...$end/; } my $name_decoded = $name; enc_urldecode($name_decoded); my $diskitem_parent = "$PREF{uploaded_files_realpath}/$path"; my $diskitem = "$PREF{uploaded_files_realpath}/$path/$name_decoded"; my $siteitem = "$PREF{uploaded_files_urlpath}/$path/$name_decoded"; s![/\\]{2,}!/!g for ($diskitem_parent, $diskitem, $siteitem); if($itemtype eq 'folder') { exit_with_error("Insufficient privileges on the parent folder.") unless get_effective_folder_permissions($PREF{logged_in_username}, $path) =~ /^rw$/i; exit_with_error("Insufficient privileges on the folder.") unless get_effective_folder_permissions($PREF{logged_in_username}, "$path/$name_decoded") =~ /^rw$/i; my @folders = get_all_subdirs($diskitem); foreach my $folder (@folders) { $folder = "$path/$name_decoded/$folder"; exit_with_error("Insufficient privileges on the folder contents.") unless get_effective_folder_permissions($PREF{logged_in_username}, $folder) =~ /^rw$/i; } } elsif($itemtype eq 'file') { exit_with_error("Insufficient privileges on the parent folder.") unless get_effective_folder_permissions($PREF{logged_in_username}, $path) =~ /^rw$/i; } else { die_nice("$PREF{internal_appname}: delete_item(): Invalid itemtype '$itemtype'."); } if($really) { my $new_qs = get_path_and_userdir_for_qs(); # We can't do a print:Location... here because we're likely running under # an SSI/PHP include, which means headers have already been sent. So do # a meta-refresh instead. # my $go = $ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : qq`$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_filelist}?action=listfiles` . ($new_qs ? "&$new_qs" : undef); my $redirect_after_deletion = "Content-type: text/html\n\n" . qq`\n`; if($itemtype eq 'file') { my $success = unlink($diskitem); if(!$success) { exit_with_error("Warning: could not delete '$diskitem'.  The file may simply be in use by another application, so try again later.  If the problem persists, there may be a permissions error.  (Error was: '$!'.)"); } my $infofile_error = (); my ($file_with_urlpath) = ($diskitem =~ /^$PREF{DOCROOT}(.+$)/); if(-e (my $infofile = get_info_filename_withpath($file_with_urlpath)) ) { #printd "deleting $infofile\n"; unlink($infofile) or $infofile_error = qq`$0: couldn't unlink (delete) infofile "$infofile": $!\n`; } if($infofile_error) { start_html_output('Deleting...', 'css'); print qq`

File deleted successfully:

` . qq`\n
$displayname
` . qq`\n`; print qq`



However, there was a problem removing the infofile:

\n

$infofile_error

\n\n`; finish_html_output('home','uploader','list'); } else { print $redirect_after_deletion unless $batchmode; } } else { my $infofile_errors = delete_directory($diskitem); if(@$infofile_errors) { start_html_output('Deleting...', 'css'); print qq`

Directory deleted successfully:

` . qq`\n
$siteitem
` . qq`\n`; print qq`



However, there were problems deleting the infofile(s):

` . qq`\n

` . join "\n

", @$infofile_errors . qq`\n

`; finish_html_output('home','uploader','list'); } else { print $redirect_after_deletion unless $batchmode; } } } else { start_html_output('Confirm deletion', 'css'); if($itemtype eq 'file') { print qq`

Really delete this file?

` . qq`\n

$displayname

` . qq`\n`; } else { print qq`

Really delete this directory?

\n` . qq`\n

$siteitem

` . qq`\n`; my ($filecount, $dircount) = count_items($diskitem); if($filecount || $dircount) { print qq`\n

This directory contains $filecount file(s) and $dircount folder(s) (including hidden items).  ` . qq`\nIf you delete it, they will all be deleted too.  Are you sure you want ` . qq`\nto delete this directory and all its contents?

` . qq`\n`; } } print qq`\n

[Yes]   ` . qq`\n[No]

` . qq`\n`; finish_html_output('home','uploader','list'); } } sub move_item { my $action = shift; my $itemtype = shift; # 'file' or 'folder'. my $item = shift; my $src = shift; my $dst = shift || ''; unless(user_is_allowed_to('move_items')) { #print_not_allowed_error_and_exit(); exit_with_access_denied(); } enc_urldecode($item, $src, $dst); $item = enc_untaint($item); $src = enc_untaint($src, 'keep_path') if $src; exit_with_error("Insufficient privileges on directory to be moved.") if ($itemtype eq 'folder' && get_effective_folder_permissions($PREF{logged_in_username}, "$src/$item") !~ /^rw$/i); exit_with_error("Insufficient privileges on source directory.") unless get_effective_folder_permissions($PREF{logged_in_username}, $src) =~ /^rw$/i; if($action eq 'move') { if($dst) # otherwise we're in stage 1 of the move operation and the dest hasn't been chosen yet. { $dst = enc_untaint($dst, 'keep_path'); exit_with_error("Insufficient privileges on destination directory.") unless get_effective_folder_permissions($PREF{logged_in_username}, $dst) =~ /^rw$/i; } } else # rename, so $dst is a filename with no path. { $dst = enc_untaint($dst) if $dst; clean_up_filename($dst) if $PREF{clean_up_filenames} =~ /yes/i; remove_reserved_strings($dst); exit_with_error($TEXT{Error_illegal_filename_}) if filename_is_illegal($dst); } # Note: here "local" means just like "url" except without $PREF{uploaded_files_urlpath} on the front. my ($localsrc, $localdst, $urlsrc, $urldst, $fullsrc, $fulldst, $fullitem_src, $fullitem_dst, $urlitem_src, $urlitem_dst, $localitem_src, $localitem_dst) = (); $localsrc = '/' . $src; $urlsrc = $PREF{uploaded_files_urlpath} . $localsrc; $urlitem_src = $PREF{uploaded_files_urlpath} . $localsrc . '/' . $item; $fullsrc = $PREF{uploaded_files_realpath} . $localsrc; $fullitem_src = $PREF{uploaded_files_realpath} . $localsrc . '/' . $item; $localitem_src = $localsrc . '/' . $item; if($action eq 'move') { $localdst = '/' . $dst; $urldst = $PREF{uploaded_files_urlpath} . $localdst; $urlitem_dst = $PREF{uploaded_files_urlpath} . $localdst . '/' . $item; $fulldst = $PREF{uploaded_files_realpath} . $localdst; $fullitem_dst = $PREF{uploaded_files_realpath} . $localdst . '/' . $item; $localitem_dst = $localdst . '/' . $item; } else # rename. here, $dst is just a filename or foldername with no path (and the "src=" on the URL was null) -- the path for dst is the same as the src path. { $localdst = '/'; $urldst = $urlsrc; $urlitem_dst = $urlsrc . $localdst . $dst; $fulldst = $fullsrc; $fullitem_dst = $fullsrc . $localdst . $dst; $localitem_dst = $localdst . $dst; } s![/\\]{2,}!/!g for ($localsrc, $localdst, $urlsrc, $urldst, $fullsrc, $fulldst, $fullitem_src, $fullitem_dst, $urlitem_src, $urlitem_dst); if($dst) { if(! -e $fullitem_src) { exit_with_error(qq`Error: can't find $itemtype $item in $urlsrc.`); } elsif(($itemtype eq 'file' && ! -f $fullitem_src) || ($itemtype eq 'folder' && ! -d $fullitem_src) || ($itemtype !~ /^(file|folder)$/)) { exit_with_error(qq`Error: specified item type does not match actual item type.`); } elsif($action eq 'rename' && -f $fullitem_src && ! -d $fullitem_src && $dst !~ /.+\..+/ && $PREF{allow_files_without_extensions} !~ /yes/i) { # If the source is a normal file (not a directory) and the destination # filename doesn't have an extension, but they've enabled the extension # filters, then it's an error. exit_with_error(qq`Error: destination filename ("$dst") appears to have no extension.`); } elsif(-e $fullitem_dst) { exit_with_error(qq`Error: there is already a $itemtype named $item in $urldst.  If you really want to overwrite it you must delete the existing $itemtype first.`); } else { my ($title, $output, $errormsg) = (); if($action eq 'move') { $title = "$TEXT{Moving}..."; $output = qq`

$TEXT{Moved} $TEXT{$itemtype}:

\n

$item

` . qq`

$TEXT{From_}

\n

$urlsrc

` . qq`

$TEXT{To_}

\n

$urldst

` . qq`\n` . qq`\n`; $errormsg = qq`Error while trying to move $itemtype "$item" from $urlsrc to $urldst: $!`; } else { $title = "$TEXT{Renaming}..."; $output = qq`

$TEXT{Renamed} $TEXT{$itemtype}:

\n

$item

` . qq`

$TEXT{To_}

\n

$dst

` . qq`

$TEXT{In_}

\n

$urlsrc

` . qq`\n` . qq`\n`; $errormsg = qq`Error while trying to rename $itemtype "$item" to "$dst" in $urlsrc: $!`; } my ($files_for_infofiles, undef) = get_items($fullitem_src) if($itemtype eq 'folder'); if(rename($fullitem_src, $fullitem_dst)) { my (@infofile_errors, $custom_folder_perms_errors) = (); if($itemtype eq 'folder') { my $errors = move_all_infofiles($files_for_infofiles, $urlitem_src, $urlitem_dst); @infofile_errors = @$errors if @$errors; my ($old_dir_name) = ($fullitem_src =~ m!^$PREF{uploaded_files_realpath}(.*)!); my ($new_dir_name) = ($fullitem_dst =~ m!^$PREF{uploaded_files_realpath}(.*)!); $custom_folder_perms_errors = update_custom_folder_perms_for_dir($old_dir_name, $new_dir_name) if custom_folder_perms_enabled(); } else { #printd "\$localitem_src=$localitem_src\n"; #printd "get_info_filename_withpath(\$localitem_src)=" . get_info_filename_withpath($localitem_src) . "\n"; if(-e (my $old_infofile = get_info_filename_withpath($localitem_src)) ) { #printd "-e is true\n"; my $new_infofile = get_info_filename_withpath($localitem_dst); #printd "new_infofile: $new_infofile\n"; rename($old_infofile, $new_infofile) or push @infofile_errors, qq`couldn't move infofile from "$old_infofile" to "$new_infofile": $!`; } if($PREF{store_upload_info_in_database} =~ /yes/i) { slashify(my $oldpath = $localsrc); slashify(my $newpath = $localdst); my $oldfilename = $item; my $newfilename = $action eq 'move' ? $item : $dst; sql_untaint($newpath, $newfilename, $oldpath, $oldfilename); my $sth = $PREF{dbh}->prepare(qq`UPDATE $PREF{db_table_for_upload_info} SET filepath='$newpath',filename='$newfilename' WHERE filepath='$oldpath' AND filename='$oldfilename' LIMIT 1;`); my $success = $sth->execute(); if(!$success || $success =~ /^(0|0E0)$/) { push(@infofile_errors, qq`couldn't update filepath (from '$oldpath' to '$newpath') and/or filename (from '$oldfilename' to '$newfilename') in upload info database: $DBI::errstr`); #printd "infofile_errors[0]=$infofile_errors[0]\n"; } } } start_html_output($title, 'css'); print $output; if(@infofile_errors || $custom_folder_perms_errors) { print qq`



However, there were problems moving the infofile(s) and/or updating the item permissions:

` . qq`\n

` . join("\n

", @infofile_errors) . qq`\n

` . qq`\n



$custom_folder_perms_errors

\n`; } finish_html_output('home','uploader','list'); } else { exit_with_error($errormsg); } } } else { my $hidden_userdir_input = $PREF{enable_userdir_on_url} =~ /yes/i && $PREF{keep_userdir_on_url} =~ /yes/i ? qq`` : ''; start_html_output("Move/Rename $itemtype", 'css'); print qq`

$TEXT{Move} $TEXT{$itemtype}:

\n

$item

` . qq`\n

$TEXT{From_}

\n

$urlsrc

` . qq`\n

$TEXT{To_}

` . qq`\n
` . qq`\n` . $hidden_userdir_input . qq`\n` . qq`\n` . qq`\n` . qq`\n` . qq`\n

` . qq`\n
` . qq`\n`; print qq`\n
` . qq`\n

$TEXT{Or_}

` . qq`\n
` . qq`\n

$TEXT{Rename} $TEXT{$itemtype}:

\n

$item

` . qq`\n

$TEXT{To_}

` . qq`\n
` . qq`\n` . $hidden_userdir_input . qq`\n` . qq`\n` . qq`\n` . qq`\n` . qq`\n

` . qq`\n

` . qq`\n`; finish_html_output('home','uploader','list'); } } sub view_items { my $selections = get_cookie($PREF{selection_cookie_name}); my $i = 1; my @items = split(/:\|:\|:/, $selections); start_html_output($PREF{view_items_page_name}, 'css', 'js'); print $PREF{view_items_page_intro} . "\n"; print qq`\n`; foreach my $item (sort @items) { my ($path, $file) = ($item =~ m!(.*)/(.+)!); unless($file) { $file = $item; $path = (); } print qq`\n`; $i++; } print qq`
$i: $item
\n`; print qq`

(No items)

\n` unless $selections; if($selections) { print qq`
` . qq`\n
` . qq`\n` . ($PREF{enable_userdirs} =~ /yes/i && $PREF{enable_userdir_on_url} =~ /yes/i ? qq`\n` : undef) . qq`\n` . $PREF{place_order_fields} . qq`\n
` . qq`\n
` . qq`\n`; print qq`

$PREF{clear_selections_text}

\n`; } finish_html_output('home','uploader','list'); } sub process_order { my $selections = get_cookie($PREF{selection_cookie_name}); die_nice(qq`Error: your cart is empty.`) unless $selections; my @items = split(/:\|:\|:/, $selections); my $user_info = (); my $user_email = (); for(split(/&/, $qs)) { my ($name, $value) = split(/=/); next if $name eq 'action'; enc_urldecode($name); enc_urldecode($value); $user_info .= qq`

$name: $value

\n`; $user_email = $value if ($name =~ /e-?mail/i); } my $email_message = qq`\n` . qq`\n$PREF{order_email_top_intro}` . qq`\n$PREF{order_email_user_intro}` . qq`\n$user_info` . qq`\n$PREF{order_email_items_intro}` . qq`\n\n` . qq`\n`; my $i = 1; foreach my $item (sort @items) { my ($path, $file) = ($item =~ m!(.*)/(.+)!); unless($file) { $file = $item; $path = (); } my $link = get_download_link($path, $file); $link = "$PREF{protoprefix}$ENV{HTTP_HOST}$link" unless $link =~ m!^https?://!; $email_message .= qq`\n`; $i++; } $email_message .= qq`
$i: $item
\n\n\n`; # send the email. my @recipients = (); foreach my $pref (sort keys %PREF) { if($pref =~ /^order_email_recipient_\d+$/) { push @recipients, $PREF{$pref}; } } push (@recipients, $user_email) if $PREF{send_copy_to_userEntered_email_address} =~ /yes/i; for(@recipients) { die_nice(qq`Error: cannot continue because this email address is invalid: "$_".`) unless /.+\@.+\..+/; } for(@recipients) { send_email($_, $PREF{order_sender_email_address}, $PREF{order_email_subject}, $email_message, 'text/html', 'die_on_email_error'); } # clear the user's cart and redirect to the confirmation page. set_cookie($PREF{selection_cookie_name}, undef); my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_filelist}?" . ($PREF{keep_userdir_on_url} ? get_userdir_for_qs() : undef) . "action=order_confirmation&items=$selections"; enc_redirect($go); } sub order_confirmation { my @items = (); if($qs =~ /(?:^|&)items=(.+?)(?:&|$)/) { my $selections = $1; enc_urldecode($selections); @items = split(/:\|:\|:/, $selections); } start_html_output($PREF{process_order_page_name}, 'css', 'js'); print $PREF{process_order_page_intro} . "\n"; if(@items) { print qq`\n`; my $i = 1; foreach my $item (sort @items) { my ($path, $file) = ($item =~ m!(.*)/(.+)!); unless($file) { $file = $item; $path = (); } print qq`\n`; $i++; } print qq`
$i: $item
\n`; } finish_html_output('home','uploader','list'); } sub die_nice { exit_with_error(@_); } sub get_db_connection { if(!$PREF{dbh} || $_[0] eq 'force') { open(my $infh,"<$PREF{tmpfl1}") or die "$0: couldn't open $PREF{tmpfl1} for reading: $!\n"; flock $infh, 1; seek $infh, 0, 0; my $this = <$infh>; close $infh or die "$0: couldn't close $PREF{tmpfl1}: $!\n"; open($infh,"<$PREF{tmpfl2}") or die "$0: couldn't open $PREF{tmpfl2} for reading: $!\n"; flock $infh, 1; seek $infh, 0, 0; my $that = <$infh>; close $infh or die "$0: couldn't close $PREF{tmpfl2}: $!\n"; chomp ($this,$that); $PREF{dbh} = DBI->connect("dbi:mysql:$PREF{database_name}", $that, $this) or die "$0: $DBI::errstr\n"; if($PREF{use_database_for_temp_data} =~ /yes/i && (!temp_db_table_exists() || !temp_db_table_is_right_size())) { create_db_table_for_temp_data($PREF{dbh}); } $PREF{AutoCommit} = $PREF{dbh}->{AutoCommit}; } } sub create_db_table_for_temp_data { my $statement = qq`CREATE TABLE $PREF{table_name_for_temp_data} ` . qq`(serial VARCHAR(150) NOT NULL PRIMARY KEY, ` . qq`progress TEXT, ` . qq`currentfile SMALLINT, ` . qq`totalfiles SMALLINT, ` . qq`totalsize INT UNSIGNED, ` . qq`start_time INT UNSIGNED); `; my $sth = $PREF{dbh}->prepare($statement); $sth->execute or die "$0: couldn't create new database table $PREF{table_name_for_temp_data}: $DBI::errstr\n"; } sub temp_db_table_exists { my @alltables = $PREF{dbh}->tables(); die "$0: couldn't get table names\n" unless @alltables; my $exists = 0; foreach my $table (@alltables) { $table =~ s/[\`'"]//g; # because $PREF{dbh}->tables() returns the table-names quoted with backticks. if($table eq $PREF{table_name_for_temp_data}) { $exists = 1; last; } } return $exists; } sub temp_db_table_is_right_size { my $sth = $PREF{dbh}->prepare("SHOW COLUMNS FROM $PREF{table_name_for_temp_data};"); $sth->execute(); my @row = $sth->fetchrow; return (scalar(@row) == 6); } sub delete_directory { my $dir = shift; my ($files, $subfolders) = get_items($dir); my @infofile_errors = (); # first delete the files. # foreach my $file (@$files) { $file = enc_untaint($file, 'keep_path'); # can never be too safe... if($file =~ /^\Q$PREF{uploaded_files_realpath}\E/) { if($PREF{uploaded_files_realpath} =~ /^\Q$PREF{DOCROOT}\E/ || $PREF{uploaded_files_dir_is_in_docroot} =~ /no/i) { #printd "unlinking $file\n"; unlink($file) or die qq`$0: couldn't unlink (delete) file "$file": $!\n`; my ($file_with_urlpath) = ($file =~ /^\Q$PREF{DOCROOT}\E(.+$)/); if(-e (my $infofile = get_info_filename_withpath($file_with_urlpath)) ) { #printd "deleting $infofile\n"; unlink($infofile) or push @infofile_errors, qq`$0: couldn't unlink (delete) infofile "$infofile": $!\n`; } } else { die qq`$0: refusing to unlink "$file" because \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) does not appear to be within \$PREF{DOCROOT} ($PREF{DOCROOT}).\n`; } } else { die qq`$0: refusing to unlink "$file" because it doesn't appear to be within \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}).\n`; } } # next delete the folders. # start with the longest pathname to ensure we delete subdirectories before parent directories. # foreach my $folder (sort { length($b) <=> length($a) } @$subfolders) { $folder = enc_untaint($folder, 'keep_path'); # can never be too safe... if($folder =~ /^\Q$PREF{uploaded_files_realpath}\E/) { if($PREF{uploaded_files_realpath} =~ /^\Q$PREF{DOCROOT}\E/ || $PREF{uploaded_files_dir_is_in_docroot} =~ /no/i) { #printd "rmdir-ing $folder\n"; rmdir($folder) or die qq`$0: couldn't rmdir (delete) directory "$folder": $!\n`; } else { die qq`$0: refusing to rmdir "$folder" because \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) does not appear to be within \$PREF{DOCROOT} ($PREF{DOCROOT}).\n`; } } else { die qq`$0: refusing to rmdir "$folder" because it doesn't appear to be within \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}).\n`; } } # finally, delete the requested folder itself. # # can never be too safe... if($dir =~ /^\Q$PREF{uploaded_files_realpath}\E/) { $dir = enc_untaint($dir, 'keep_path'); if($PREF{uploaded_files_realpath} =~ /^\Q$PREF{DOCROOT}\E/ || $PREF{uploaded_files_dir_is_in_docroot} =~ /no/i) { #printd "rmdir-ing $dir\n"; rmdir($dir) or die qq`$0: couldn't rmdir (delete) directory "$dir": $!\n`; } else { die qq`$0: refusing to rmdir "$dir" because \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) does not appear to be within \$PREF{DOCROOT} ($PREF{DOCROOT}).\n`; } } else { die qq`$0: refusing to rmdir "$dir" because it doesn't appear to be within \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}).\n`; } return \@infofile_errors; } # EB, FC sub delete_files_and_folders_older_than { my $ttl = shift; my $dir = shift; my $regex = shift; # optional; if present, only matching files will be deleted. return unless -d $dir; my ($files, $subfolders) = get_items($dir); my @infofile_errors = (); # first delete the files. # foreach my $file (@$files) { $file = enc_untaint($file, 'keep_path'); next if ($regex && $file !~ /$regex/); # can never be too safe... if($file =~ /^(\Q$PREF{uploaded_files_realpath}\E|\Q$PREF{datadir}\E)/) { if($PREF{uploaded_files_realpath} =~ /^\Q$PREF{DOCROOT}\E/ || $PREF{uploaded_files_dir_is_in_docroot} =~ /no/i) { if(item_is_older_than($file, $ttl)) { #printd "unlinking $file\n"; unlink($file) or die qq`$0: couldn't unlink (delete) file "$file": $!\n`; my ($file_with_urlpath) = ($file =~ /^\Q$PREF{DOCROOT}\E(.+$)/); if(-e (my $infofile = get_info_filename_withpath($file_with_urlpath)) ) { #printd "deleting $infofile\n"; unlink($infofile) or push @infofile_errors, qq`$0: couldn't unlink (delete) infofile "$infofile": $!\n`; } } } else { die qq`$0: refusing to unlink "$file" because \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) does not appear to be within \$PREF{DOCROOT} ($PREF{DOCROOT}).\n`; } } else { die qq`$0: refusing to unlink "$file" because it doesn't appear to be within \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) or \$PREF{datadir} ($PREF{datadir}).\n`; } } # next delete the folders. # start with the longest pathname to ensure we delete subdirectories before parent directories. # foreach my $folder (sort { length($b) <=> length($a) } @$subfolders) { $folder = enc_untaint($folder, 'keep_path'); next if ($regex && $folder !~ /$regex/); # can never be too safe... if($folder =~ /^\Q$PREF{uploaded_files_realpath}\E/) { if($PREF{uploaded_files_realpath} =~ /^\Q$PREF{DOCROOT}\E/ || $PREF{uploaded_files_dir_is_in_docroot} =~ /no/i) { if(item_is_older_than($folder, $ttl)) { my ($numfiles,$numdirs) = count_items($folder); if($numfiles > 0 || $numdirs > 0) { warn qq`$0: won't attempt to rmdir directory "$folder" because it isn't empty.\n`; } else { #printd "rmdir-ing $folder\n"; rmdir($folder) or die qq`$0: couldn't rmdir (delete) directory "$folder": $!\n`; } } } else { die_nice(qq`$PREF{internal_appname}: delete_files_and_folders_older_than(): refusing to rmdir "$folder" because \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}) does not appear to be within \$PREF{DOCROOT} ($PREF{DOCROOT}).\n`); } } else { die_nice(qq`$PREF{internal_appname}: delete_files_and_folders_older_than(): refusing to rmdir "$folder" because it doesn't appear to be within \$PREF{uploaded_files_realpath} ($PREF{uploaded_files_realpath}).\n`); } } return \@infofile_errors; } # EB, FC sub item_is_older_than { my $item = shift; my $allowed_hours = shift; my $mtime = (stat($item))[9]; my $current_time = time; return unless ($mtime =~ /^\d{2,}$/ && $current_time =~ /^\d{2,}$/); my $age_in_seconds = $current_time - $mtime; my $age_in_hours = $age_in_seconds / 3600; if($age_in_hours > $allowed_hours) { #printd "item_is_older_than(): item $item has age $age_in_hours, which exceeds allowed hours ($allowed_hours).\n"; return 1; } else { return 0; } } sub get_dir_size { my $dir = shift; my ($files,undef) = scan_dir_for_contents($dir, 'return_the_items_themselves'); my $totalsize = 0; foreach my $file (@$files) { $totalsize += (stat($file))[7]; } return $totalsize; } # note: returns (numfiles,numdirs). sub count_items { my $dir = shift; my $arg = shift; return scan_dir_for_contents($dir, 'return_the_item_counts', $arg); } # EB, FC, photos sub get_items { my $dir = shift; return scan_dir_for_contents($dir, 'return_the_items_themselves'); } # EB, FC, photos sub scan_dir_for_contents { my $dir = shift; my $mode = shift; my $ignore_hidden_items = shift; $ignore_hidden_items = $ignore_hidden_items && $ignore_hidden_items eq 'ignore_hidden_items' ? 1 : 0; #printd "\n\ndir: $dir\n"; my @all_dirs = ($dir); my @all_subdirs = get_all_subdirs($dir); for(@all_subdirs) { push @all_dirs, $dir . '/' . $_; } my @all_files = (); foreach my $subdir (@all_dirs) { # don't use images from our own thumbnail folders. next if $ignore_hidden_items && $subdir =~ m!(^|/|\\)$PREF{filelist_thumbnail_dir_name}(/|\\|$)!; opendir(SCANDIRFH, $subdir) or die "$0: 22 couldn't open directory $subdir: $!\n"; my $dirh = \*SCANDIRFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". my @files = grep { ! -d "$subdir/$_" } readdir($dirh); closedir $dirh or die "$0: couldn't close directory $subdir: $!\n"; for(@files) { push @all_files, $subdir . '/' . $_; } #printd "subdir $subdir contains:" . join ", ", @files; print STDERR "\n"; } if($mode eq 'return_the_items_themselves') { my @all_subdirs_with_paths = (); for(@all_subdirs) { push @all_subdirs_with_paths, $dir . '/' . $_; } return (\@all_files, \@all_subdirs_with_paths); } elsif($mode eq 'return_the_item_counts') { my ($numfiles, $numdirs) = ($#all_files + 1, $#all_subdirs + 1); #printd "numfiles=$numfiles, numdirs=$numdirs\n"; return ($numfiles, $numdirs); } } # EB, FC, photos sub get_all_subdirs { my $dir = shift; my $mode = shift; unless(-d $dir) { print_http_headers(); print qq`

Error: get_all_subdirs(): we need a directory, but we received "$dir".

\n`; return; } opendir(DIRHFORALLSUBDIRS, $dir) or die "$0: 33 couldn't open directory $dir: $!\n"; my @dirs = sort { lc($a) cmp lc($b) } grep { -d "$dir/$_" && -w "$dir/$_" && !/^\.$/ && !/\.{2}/ } readdir(DIRHFORALLSUBDIRS); closedir DIRHFORALLSUBDIRS or die "$0: couldn't close directory $dir: $!\n"; my @subdirs = (); # now recurse through everything below this point. foreach my $level1dir (@dirs) { foreach my $level2dir (get_all_subdirs("$dir/$level1dir")) { push @subdirs, "$level1dir/$level2dir"; } } push @dirs, @subdirs; return sort { lc($a) cmp lc($b) } @dirs; } sub get_all_writable_directories { #printd "get_all_writable_directories('$_[0]')\n"; my $inputdir = $PREF{uploaded_files_realpath}; my @dirs = get_all_subdirs($inputdir); $inputdir =~ s/^$PREF{uploaded_files_realpath}//; $inputdir = '/' unless $inputdir; unshift @dirs, $inputdir; # This code is sort of awkward to handle the custom folder perms # and the userdirs when they interact with each other. This seems # to be the most straightforward way to code it. Note that the # chain here must be if/elsif, not multiple ifs: we're handling # each case one at a time in its entirety, rather than doing # multiple ifs on the outside and trying to combine the results # afterwards. my (%output,@output) = (); if(custom_folder_perms_enabled()) { foreach my $dir (@dirs) { #print STDERR "alldirs: '$dir'\n"; if(get_effective_folder_permissions($PREF{logged_in_username}, $dir) =~ /^rw$/i) { printd "dir: '$dir' writable (via folder perms)\n"; $output{$dir} = 1; } #elsif(is_userdir_folder($dir)) #{ # if(is_userdir_folder_that_this_user_can_access($dir)) # { # $output{$dir} = 1; # } #} elsif(is_userdir_folder_that_this_user_can_access($dir)) { printd "dir: '$dir' writable (via userdir)\n"; $output{$dir} = 1; } } foreach my $dir (sort { length($a) <=> length($b) } keys %output) { #print STDERR "writable: $dir\n"; push @output, $dir; } return @output; } elsif($PREF{enable_userdirs} =~ /yes/i) { foreach my $dir (@dirs) { #printd "dir: '$dir'\n"; if(is_userdir_folder_that_this_user_can_access($dir)) { #printd "userdir '$dir' writable\n"; $output{$dir} = 1; } } foreach my $dir (sort { length($a) <=> length($b) } keys %output) { push @output, $dir; } return @output; } else { return @dirs; } } sub is_userdir_folder($) { return $PREF{enable_userdirs} =~ /yes/i && $_[0] =~ m!^$PREF{userdir_folder_name}(/|$)!; } sub is_userdir_folder_that_this_user_can_access($) { my $access = $PREF{admin_is_logged_in} || ($PREF{enable_userdirs} =~ /yes/i && $PREF{userdir} && $_[0] =~ m!^/?$PREF{userdir_folder_name}/$PREF{userdir}(/|$)!); #print STDERR "is_userdir_folder_that_this_user_can_access('$_[0]'): returning $access\n"; return user_is_allowed_to('view_all_userdirs') || ($PREF{enable_userdirs} =~ /yes/i && $PREF{userdir} && $_[0] =~ m!^/?$PREF{userdir_folder_name}/$PREF{userdir}(/|$)!); } sub get_userdir { my $userdir = ''; return undef unless $PREF{enable_userdirs} =~ /yes/i; return undef if $PREF{admin_is_logged_in}; # because admins are allowed to browse all user's dirs, and upload to anywhere they want. if($PREF{integrate_with_userbase} =~ /yes/i) { $userdir = $PREF{logged_in_username}; if(!$userdir && $PREF{error_if_userdir_not_supplied} =~ /yes/i) { $PREF{userbase_login_error_message} =~ s!%%login_link%%!log in!g; $PREF{userbase_login_error_message} .= qq`\n\n`; exit_with_notice($PREF{userbase_login_error_message}); } } elsif($PREF{enable_userdir_from_cookie} =~ /yes/i) { $userdir = get_cookie($PREF{userdir_cookie_name}); if(!$userdir && $PREF{error_if_userdir_not_supplied} =~ /yes/i) { exit_with_notice($PREF{login_error_message}); } } elsif($PREF{enable_userdir_from_php_session__method1} =~ /yes/i) { if($ENV{PHP_ENC_USERDIR}) { $userdir = $ENV{PHP_ENC_USERDIR}; save_php_var_to_cache('userdir',$userdir); } else # we were POSTed to? { $userdir = get_php_var_from_cache('userdir'); } if(!$userdir && $PREF{error_if_userdir_not_supplied} =~ /yes/i) { exit_with_notice($PREF{login_error_message}); } } elsif($PREF{enable_userdir_from_php_session__method2} =~ /yes/i) { eval { require PHP::Session; }; if($@) { die_nice($@); } else { my $session = PHP::Session->new( get_cookie($PREF{php_session_cookie_name}), { save_path => $PREF{php_session_save_path} } ); $userdir = $session->get($PREF{php_session_username_variable}); } if(!$userdir && $PREF{error_if_userdir_not_supplied} =~ /yes/i) { exit_with_notice($PREF{login_error_message}); } } elsif($PREF{enable_userdir_on_url} =~ /yes/i) { if($qs =~ /(?:^|&)userdir=(.+?)(?:&|$)/) { $userdir = $1; } elsif($PREF{serial_is_userdir} =~ /yes/i && $PREF{serial} =~ /\S+/) { $userdir = $PREF{serial}; } else { if($PREF{error_if_userdir_not_supplied} =~ /yes/i) { exit_with_error(qq`Error: malformed URL; you need to pass userdir=yourusername on the URL.`); } # if no userdir was passed, and the webmaster doesn't want that to be # an error, then we just have to return null and use the top-level # dir for this upload. } } unless($PREF{allow_unsafe_userdir_names} =~ /yes/i) { $userdir = enc_untaint($userdir) if $userdir; } return $userdir; } # FC, VL sub save_php_var_to_cache($$) { my $new_var = shift; my $new_value = shift; my $new_date = offsettime(); my $new_sessid = get_cookie($PREF{php_session_cookie_name}); for($new_var, $new_value, $new_date, $new_sessid) { s/:::::/ENCFIVECOLONS/g; s/\n/ENCNEWLINE/g; } my ($session_found, $var_found) = (); create_file_if_DNE($PREF{php_session_cache_file},0666); my @new_contents = (); open(CACHEFH,"+<$PREF{php_session_cache_file}") or die_nice("$PREF{internal_appname}: save_php_var_to_cache('$new_var', '$new_value'): couldn't open cache file '$PREF{php_session_cache_file}' for R/W: $!\n"); my $iofh = \*CACHEFH; flock $iofh, 2; seek $iofh, 0, 0; while(<$iofh>) { if(/^date=(\d+?):::::sessid=(\w+?):::::.+/) { chomp; my ($date, $sessid) = ($1, $2); if($new_date - $date < $PREF{php_session_cache_ttl}) { if($sessid ne $new_sessid) { # If this record doesn't belong to the current user, don't bother processing it. push (@new_contents, "$_\n"); } else { $session_found = 1; my $new_line = "date=${date}:::::sessid=${sessid}:::::"; foreach my $var (split(/:::::/)) { my ($name,$value) = ($var =~ /(\w+)=(.*)/); next if $name =~ /^(date|sessid)$/i; if($name eq $new_var) { $new_line .= "$name=${new_value}:::::"; $var_found = 1; } else { $new_line .= "$name=${value}:::::"; } } $new_line .= "$new_var=${new_value}:::::" if !$var_found; push (@new_contents, "$new_line\n"); } } } } push (@new_contents, "date=${new_date}:::::sessid=${new_sessid}:::::$new_var=${new_value}:::::\n") if !$session_found; seek $iofh, 0, 0; print $iofh @new_contents; truncate $iofh, tell $iofh; close $iofh or die_nice("$PREF{internal_appname}: save_php_var_to_cache('$new_var', '$new_value'): couldn't close cache file '$PREF{php_session_cache_file}' after R/W: $!\n"); } # FC, VL sub get_php_var_from_cache($) { my $new_var = shift; my $new_value = ''; my $new_date = offsettime(); my $new_sessid = get_cookie($PREF{php_session_cookie_name}); for($new_var, $new_value, $new_date, $new_sessid) { s/:::::/ENCFIVECOLONS/g; s/\n/ENCNEWLINE/g; } create_file_if_DNE($PREF{php_session_cache_file},0666); open(CACHEFH,"<$PREF{php_session_cache_file}") or die_nice("$PREF{internal_appname}: get_php_var_from_cache('$new_var'): couldn't open cache file '$PREF{php_session_cache_file}' for reading: $!\n"); my $infh = \*CACHEFH; flock $infh, 1; seek $infh, 0, 0; while(<$infh>) { if(/^date=(\d+?):::::sessid=(\w+?):::::.+/) { my ($date, $sessid) = ($1, $2); if($new_date - $date < $PREF{php_session_cache_ttl} && $sessid eq $new_sessid) { if(/(?:^|:::::)$new_var=(.*?)(?::::::|$)/) { $new_value = $1; } } } } close $infh or die_nice("$PREF{internal_appname}: get_php_var_from_cache('$new_var'): couldn't close cache file '$PREF{php_session_cache_file}' after reading: $!\n"); return $new_value; } sub file_is_allowed_to_be_displayed { my $item = shift; my $allowed = 1; if($PREF{only_show_files_with_these_extensions} =~ /(.+)/) { my ($this_items_extension) = ($item =~ /.*(\..+)$/); die qq`$0: could not determine the extension for item "$item".\n` unless ($this_items_extension || $PREF{allow_files_without_extensions} =~ /yes/i); unless( $PREF{allowed_extensions}{lc($this_items_extension)} ) { $allowed = 0; } } if($PREF{hide_files_with_these_extensions} =~ /(.+)/) { my ($this_items_extension) = ($item =~ /.*(\..+)$/); die qq`$0: could not determine the extension for item "$item".\n` unless ($this_items_extension || $PREF{allow_files_without_extensions} =~ /yes/i); if( $PREF{disallowed_extensions}{lc($this_items_extension)} ) { $allowed = 0; } } if(item_is_hidden($item)) { $allowed = 0; } return $allowed; } sub folder_is_allowed_to_be_displayed { #printd "folder_is_allowed_to_be_displayed('$_[0]')\n"; my $item = shift || ''; slashify($item); foreach my $dir (split(/\//, $item)) { next unless $dir; if(item_is_hidden($dir)) { return 0; } } if(custom_folder_perms_enabled()) { return 0 unless get_effective_folder_permissions($PREF{logged_in_username}, $item) =~ /^r[ow]$/i; } return 1; } sub item_is_hidden { my $item = shift; if($PREF{hide_items_whose_names_match} =~ /(.+)/) { foreach my $disallowed_name (split(/[,\s]+/, $PREF{hide_items_whose_names_match})) { if($item =~ /$disallowed_name/i) { return 1; } } } } sub clean_up_filename { for(@_) { s/\s+/_/g if $_; } for(@_) { s/[^0-9A-Za-z\._-]//g if $_; } } sub clean_up_text { for(@_) { s/\s+/_/g if $_; } for(@_) { s/[^0-9A-Za-z\._-]//g if $_; } } sub get_storable_url_variables { my $format = shift; my $hash_to_populate = shift; my $urldecode = shift; $urldecode = $urldecode eq 'urldecode' ? 1 : 0; my $urlvars = (); if($PREF{store_values_from_these_url_variables} =~ /\S/) { foreach my $var (split(/[,\s]+/, $PREF{store_values_from_these_url_variables})) { if($qs =~ /(?:^|&)$var=(.*?)(?:&|$)/) { my $value = $1; enc_urldecode($value) if $urldecode; my $urldecoded_value = $value; enc_urldecode($urldecoded_value); $$hash_to_populate{$var} = $urldecoded_value if $hash_to_populate; # Always URL-decode this one because it's for the DB. if($format =~ /^html$/i) { $urlvars .= qq`\n

URL Variable ${var}: $value

\n`; } else { $urlvars .= qq`\nURL Variable ${var}: $value\n\n`; } } } } return $urlvars; } sub store_upload_info { my ($i, $filename_with_urlpath, $filename_with_localpath, $filesize, $serial, $textboxes) = @_; # $textboxes is a hashref. my %INFO = (); ($INFO{filepath}, $INFO{filename}) = ($filename_with_localpath =~ m!^(.*[/\\])(.+)$!); $INFO{origpath} = $INFO{filepath}; $INFO{origname} = $INFO{filename}; $INFO{filesize} = $filesize; $INFO{uploadsize} = $ENV{CONTENT_LENGTH}; $INFO{filecount} = $PREF{uploaddata}{$serial}{totalfiles}; $INFO{serial} = $serial; ($INFO{ip},$INFO{host}) = get_ip_and_host(); $INFO{userdir} = get_userdir() ? get_userdir() : '(none)'; $INFO{username} = $PREF{logged_in_username} ? $PREF{logged_in_username} : '(none)'; $INFO{useragent} = $ENV{HTTP_USER_AGENT}; $INFO{startetime} = $PREF{uploaddata}{$serial}{start_time}; $INFO{starttime} = strftime("%a%b%d,%Y,%I:%M%P", localtime($INFO{startetime})); $INFO{endetime} = $PREF{uploaddata}{$serial}{end_time}; $INFO{endtime} = strftime("%a%b%d,%Y,%I:%M%P", localtime($INFO{endetime})); $INFO{elapsecs} = $INFO{endetime} - $INFO{startetime}; $INFO{elapmins} = $INFO{elapsecs} / 60; $INFO{elaphours} = $INFO{elapsecs} / 3600; s/(.*\.\d).*/$1/ for ($INFO{elapmins}, $INFO{elaphours}); $INFO{counternum} = $PREF{upload_counter_value}; # get any URL variable values (into %INFO hash). my $all_url_vars = get_storable_url_variables('text', \%INFO); # get any custom textbox values (into %INFO hash). foreach my $textbox (keys %$textboxes) { my $textbox_without_filenumber = $textbox; $textbox_without_filenumber =~ s/^(formfield_\d+)_\d+$/$1/; # remove trailing digit in case this is a perfile textbox. my $shortname = $PREF{"${textbox_without_filenumber}_shortname"}; if($textbox ne $textbox_without_filenumber) # then it's a perfile textbox { if($textbox =~ /_$i$/) # make sure we get the value from the textbox for the proper file (the one ending in the current $i) { $INFO{$shortname} = $$textboxes{$textbox}{value}; } } else { $INFO{$shortname} = $$textboxes{$textbox}{value}; } } if($PREF{store_upload_info_in_database} =~ /yes/i) { my ($cols_for_query,$vals_for_query) = (); my $query = qq`INSERT INTO $PREF{db_table_for_upload_info} `; foreach my $col (split(/,/, $PREF{db_columns_for_upload_info})) { next if $INFO{$col} eq ''; # if it's null, don't bother; otherwise we get an "Out of range value adjusted for column" error from MySQL. $INFO{$col} =~ s/::NEWLINE::/\n/g; sql_untaint($col,$INFO{$col}); $cols_for_query .= $col . ','; $vals_for_query .= qq`'$INFO{$col}',`; } $cols_for_query =~ s/,$//; $vals_for_query =~ s/,$//; $query .= qq`($cols_for_query) VALUES($vals_for_query);`; my $sth = $PREF{dbh}->prepare($query); $sth->execute() or die "$0: store_upload_info(): $DBI::errstr\n"; } if($PREF{store_upload_info_in_files} =~ /yes/i) { my $infofile = get_info_filename_withpath($filename_with_localpath); # The name of the infofile is taken from the name of the uploaded file itself, # and it gets serialized along with the name of the uploaded file. So the only # way that the infofile could already exist is if someone deleted the uploaded # file outside of FileChucker (via shell, FTP, etc) and left the infofile behind. # In that case, the infofile no longer has an uploaded file to be attached to, so # we'd want to overwrite it anyway. So don't die here if the infofile already # exists. # #die_nice(qq`Error: the infofile ($infofile) for this upload ($filename_with_urlpath) already exists.`) if -e $infofile; open(UPLOADINFOOUTFH, ">$infofile") or die "$0: couldn't create infofile $infofile: $!\n"; my $outfh = \*UPLOADINFOOUTFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". flock $outfh, 2; seek $outfh, 0, 0; my $labels = get_fileinfo_labels(); if($PREF{store_upload_info_in_files__oldformat} =~ /yes/i) { print $outfh qq`$$labels{origname}$filename_with_localpath` . qq`\n$$labels{filesize}$INFO{filesize}` . qq`\n$$labels{uploadsize}$INFO{uploadsize}` . qq`\n$$labels{filecount}$INFO{filecount}` . qq`\n$$labels{serial}$INFO{serial}` . qq`\n` . qq`\n$$labels{ip}$INFO{ip}` . qq`\n$$labels{host}$INFO{host}` . qq`\n$$labels{userdir}$INFO{userdir}` . qq`\n$$labels{username}$INFO{username}` . qq`\n$$labels{useragent}$INFO{useragent}` . qq`\n` . qq`\n$$labels{starttime}$INFO{starttime}` . qq`\n$$labels{endtime}$INFO{endtime}` . qq`\n` . qq`\n$$labels{startetime}$INFO{startetime}` . qq`\n$$labels{endetime}$INFO{endetime}` . qq`\n` . qq`\n$$labels{elapsecs}$INFO{elapsecs}` . qq`\n$$labels{elapmins}$INFO{elapmins}` . qq`\n$$labels{elaphours}$INFO{elaphours}` . qq`\n` . qq`\n$$labels{counternum}$INFO{counternum}` . qq`\n`; my $textbox_values = get_textbox_values('all', $i, $textboxes, 'text', 'show_field_keynames', '!!replace_NEWLINEs', '!!mark_headings'); print $outfh $textbox_values; print $outfh $all_url_vars; } else { foreach my $field (sort keys %INFO) { print $outfh "$field: $INFO{$field}\n"; } } truncate $outfh, tell $outfh; close $outfh or die "$0: couldn't close infofile $infofile after creating it: $!\n"; chmod 0666, $infofile; } my $textbox_values_for_qs = get_textbox_values('all', undef, $textboxes, 'text', 'show_field_keynames', '!!replace_NEWLINEs', '!!mark_headings'); return $textbox_values_for_qs; } sub get_fileinfo_labels { my %labels = ( filename => $TEXT{Current_filename_}, origname => $TEXT{Original_filename_}, filesize => $TEXT{File_size_}, filecount => $TEXT{Uploaded_in_a_group_of_this_many_files_}, uploadsize => $TEXT{Total_upload_size_}, serial => $TEXT{Upload_serial_number_}, ip => $TEXT{Uploaders_IP_address_}, host => $TEXT{Uploaders_hostname_}, userdir => $TEXT{Uploaders_user_dir_}, username => $TEXT{Uploaders_username_}, useragent => $TEXT{Uploaders_user_agent_}, starttime => $TEXT{Start_time_for_entire_upload_}, endtime => $TEXT{End_time_for_entire_upload_}, startetime => $TEXT{Start_etime_for_entire_upload_}, endetime => $TEXT{End_etime_for_entire_upload_}, elapsecs => $TEXT{Elapsed_time_in_seconds_for_entire_upload_}, elapmins => $TEXT{Elapsed_time_in_minutes_for_entire_upload_}, elaphours => $TEXT{Elapsed_time_in_hours_for_entire_upload_}, counternum => $TEXT{Upload_counter_number_} ); return \%labels; } sub format_filesize_nicely { my $rawsize = my $size = shift; $size = 0 unless $size; $size = $size > 999999 ? onedecimal($size/(1024*1024)) . " $PREF{MB}" : int($size/1024) . " $PREF{KB}"; $size =~ s/^0 /1 / if $rawsize > 0; # for tiny files, round to 1 instead of 0. return $size; } sub remove_reserved_strings { for(@_) { s/-\.-\.-/_._._/g if $_; } # because we use -.-.- as a directory-separation symbol in our infofiles' filenames. } sub show_fileinfo { exit_with_access_denied() unless user_is_allowed_to('view_upload_info'); my $path = shift; my $file = shift; enc_urldecode($path, $file); $file = enc_untaint($file); $path = enc_untaint($path, 'keep_path') if $path; #clean_up_filename($dst) if $PREF{clean_up_filenames} =~ /yes/i; #remove_reserved_strings($dst); my (%INFO,%textboxes,%urlvars) = (); # make a hash of our built-in fields, so we can properly detect custom fields. my $builtin_info_fields = 'filepath,filename,origpath,origname,filesize,uploadsize,filecount,serial,ip,host,userdir,username,useragent,starttime,endtime,startetime,endetime,elapsecs,elapmins,elaphours,counternum'; my %builtin_info_fields = map { $_ => 1 } split(/,/, $builtin_info_fields); start_html_output($TEXT{Upload_Info}, 'css', 'js'); print qq`

$TEXT{Upload_Info}

\n\n`; if($PREF{store_upload_info_in_database} =~ /yes/i) { print "\n"; $path .= '/' if(!$path || $path !~ m!/$!); $path = "/$path" unless $path =~ m!^/!; my $labels = get_fileinfo_labels(); my %INFO = (); my $query = qq`SELECT $PREF{db_columns_for_upload_info} FROM $PREF{db_table_for_upload_info} WHERE filename='$file' AND filepath='$path' LIMIT 1`; #printd "query=$query\n"; my $fileinfo = $PREF{dbh}->selectrow_hashref($query); foreach my $field (split(/,/, $PREF{db_columns_for_upload_info})) { my $value = $fileinfo->{$field}; $INFO{$field} = $value; } } elsif($PREF{store_upload_info_in_files} =~ /yes/i) { print "\n"; my (@contents) = (); my $infofile = get_info_filename_withpath("$path$file"); die_nice(qq`Error: couldn't find info file for $path$file.`) unless -e $infofile; open(FILEINFOINFH, "<$infofile") or die "$0: couldn't open infofile $infofile for reading: $!\n"; my $infh = \*FILEINFOINFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". flock $infh, 1; seek $infh, 0, 0; @contents = <$infh>; close $infh or die "$0: couldn't close infofile $infofile after reading: $!\n"; foreach my $line (@contents) { if($line =~ /^(\S+): (.*)$/) { my ($field,$value) = ($1,$2); $INFO{$field} = $value; } } } $INFO{filesize} = format_filesize_nicely($INFO{filesize}) if $INFO{filesize} =~ /^\d+$/; $INFO{uploadsize} = format_filesize_nicely($INFO{uploadsize}) if $INFO{uploadsize} =~ /^\d+$/; # Replace any NEWLINEs in the values. # # Also auto-generate any custom form field values in case the # template contains the %%formfields%% variable. # my $formfields = ''; foreach my $field (sort keys %INFO) { $INFO{$field} =~ s!::NEWLINE::!\n

!g; unless($builtin_info_fields{$field}) { my $formfieldkey = get_formfield_key_from_shortname($field); $formfields .= qq`\n$PREF{$formfieldkey} $INFO{$field}`; } } $PREF{file_info_page_template} =~ s/%%formfields%%/$formfields/g; $PREF{file_info_page_template} =~ s/%%(\w+)%%/$INFO{$1}/g; print $PREF{file_info_page_template}; finish_html_output('home','uploader','list'); } sub show_fileinfo__oldformat { exit_with_access_denied() unless user_is_allowed_to('view_upload_info'); my $path = shift; my $file = shift; enc_urldecode($path, $file); $file = enc_untaint($file); $path = enc_untaint($path, 'keep_path') if $path; #clean_up_filename($dst) if $PREF{clean_up_filenames} =~ /yes/i; #remove_reserved_strings($dst); my (%textboxes,%urlvars) = (); start_html_output($TEXT{Upload_Info}, 'css', 'js'); print qq`

$TEXT{Upload_Info}

\n\n`; if($PREF{store_upload_info_in_database} =~ /yes/i) { print "\n"; $path .= '/' if(!$path || $path !~ m!/$!); $path = "/$path" unless $path =~ m!^/!; # make a hash of our built-in fields, so we can properly detect custom fields. my $builtin_info_fields = 'filepath,filename,origpath,origname,filesize,uploadsize,filecount,serial,ip,host,userdir,username,useragent,starttime,endtime,startetime,endetime,elapsecs,elapmins,elaphours,counternum'; my %builtin_info_fields = map { $_ => 1 } split(/,/, $builtin_info_fields); my $labels = get_fileinfo_labels(); my %INFO = (); my $query = qq`SELECT $PREF{db_columns_for_upload_info} FROM $PREF{db_table_for_upload_info} WHERE filename='$file' AND filepath='$path' LIMIT 1`; #printd "query=$query\n"; my $fileinfo = $PREF{dbh}->selectrow_hashref($query); my $name_and_path_done = 0; foreach my $field (split(/,/, $PREF{db_columns_for_upload_info})) { if($field eq 'filepath' || $field eq 'filename' || $field eq 'origpath' || $field eq 'origname') { next if $name_and_path_done; if($fileinfo->{filepath} && $fileinfo->{filename}) { print qq`\n
$$labels{filename}$fileinfo->{filepath}$fileinfo->{filename}
\n`; } if($fileinfo->{origpath} && $fileinfo->{origname}) { print qq`\n
$$labels{origname}$fileinfo->{origpath}$fileinfo->{origname}
\n`; } print qq`
\n`;
				$name_and_path_done = 1;
			}
			elsif($field eq 'useragent')
			{
				print qq`
\n
$$labels{$field}$fileinfo->{$field}
\n
`;
			}
			elsif($field eq 'filesize' || $field eq 'uploadsize')
			{
				my $value = format_filesize_nicely($fileinfo->{$field}) if $fileinfo->{$field} =~ /^\d+$/;
				print "$$labels{$field}$value\n";
			}
			#elsif($line =~ /^(top|perfile|bottom)_formfields_title/)
			#{
			#
			#}
			elsif($field eq 'endtime' || $field eq 'endetime')
			{
				# print an extra newline for these two, just to make the output nicer.
				print "$$labels{$field}$fileinfo->{$field}\n";
				print "\n";
			}
			elsif($builtin_info_fields{$field})
			{
				print "$$labels{$field}$fileinfo->{$field}\n";
			}
			else # else it's a custom textbox or a URL variable.
			{
				my $is_textbox = 0;
				foreach my $key (keys %PREF)
				{
					if($key =~ /^(formfield_\d+)_shortname$/)
					{
						my $formfield		= $1;
						my $position		= $PREF{"${formfield}_position"};
						my $shortname		= $PREF{$key};
						my $formfield_name	= $PREF{$formfield} ? $PREF{$formfield} : $shortname;

						if($field eq $shortname)
						{
							$is_textbox = 1;

							# The get_textbox_values() function into which %textboxes will be passed is
							# expecting any perfile textboxes to end in _N.  In this context though, we're
							# only dealing with a single file (showing its fileinfo), so we don't know 
							# the value of N; but in fact, we don't need it either -- we just need to
							# stick an arbitrary digit onto there so the function processes it correctly.
							#
							$formfield .= '_1' if $position eq 'perfile';

							$textboxes{$formfield}{name}	= $formfield_name;
							$textboxes{$formfield}{value}	= $fileinfo->{$field};
						}
					}
				}

				if(!$is_textbox) # then it's a URL variable.
				{
					$urlvars{$field} = $fileinfo->{$field};
				}
			}
		}

		print qq`
\n\n`; } elsif($PREF{store_upload_info_in_files} =~ /yes/i) { print "\n"; my @contents = (); my $infofile = get_info_filename_withpath("$path$file"); die_nice(qq`Error: couldn't find info file for $path$file.`) unless -e $infofile; open(FILEINFOINFH, "<$infofile") or die "$0: couldn't open infofile $infofile for reading: $!\n"; my $infh = \*FILEINFOINFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". flock $infh, 1; seek $infh, 0, 0; @contents = <$infh>; close $infh or die "$0: couldn't close infofile $infofile after reading: $!\n"; my $closed_pretag_already = 0; foreach my $line (@contents) { if($line =~ /^(Original filename: )(.*)$/) { print qq`\n
$1$2
\n
`;
			}
			elsif($line =~ /^(Uploader's user-agent: )(.*)$/)
			{
				print qq`
\n
$1$2
\n
`;
			}
			elsif($line =~ /^(Uploader's comments:)$/)
			{
				print qq`
\n
$1`; $closed_pretag_already = 1; } elsif($closed_pretag_already) { print '
' . $line; } elsif($line =~ /^((?:File|Total upload) size: )(.*)$/) { my ($label,$value) = ($1,$2); $value = format_filesize_nicely($value) if $value =~ /^\d+$/; print "$label$value\n"; } elsif($line =~ /^(End time|End etime|Total upload size)/) { print $line . "\n"; } elsif($line =~ /^(top|perfile|bottom)_formfields_title/) { } elsif($line =~ /^((?:top|perfile|bottom)_textbox_\d+_(?:single|multi)line(?:_\d+)?):(name|value): (.*)$/) { # Deprecated; left in so that old info files still work. $textboxes{$1}{$2} = $3; } elsif($line =~ /^(formfield_\d+(?:_\d+)?):(name|value): (.*)$/) { $textboxes{$1}{$2} = $3; } elsif($line =~ /^URL Variable (.+?): (.*)/) { $urlvars{$1} = $2; } elsif($line =~ /^(.+):(name|value): (.*)$/) { # custom form field. this check must come after the built-in-textbox check in the if/else chain. next if $2 eq 'name'; $textboxes{$1}{name} = $1; $textboxes{$1}{value} = $3; $textboxes{$1}{name} =~ s/_\d+$//; # for perfile fields. } else { if($line =~ /\S/) { print $line; } } } print qq`\n
` if $closed_pretag_already; print qq`\n` unless $closed_pretag_already; } print qq`\n\n`; my $textbox_values = get_textbox_values('all', undef, \%textboxes, 'html', '!!show_field_keynames', 'replace_NEWLINEs', 'mark_headings'); my $urlvar_output = (); foreach my $urlvar (sort keys %urlvars) { enc_urldecode($urlvars{$urlvar}); $urlvar_output .= qq`

URL Variable $urlvar: $urlvars{$urlvar}

\n`; } $textbox_values =~ s!(
){3,}$!


! if $urlvar_output; print qq`\n

$TEXT{Uploaders_Form_Field_Entries_}

\n

$textbox_values
\n\n` if $textbox_values; print $urlvar_output; finish_html_output('home','uploader','list'); } sub get_info_filename_withpath { my $filename = shift; #printd "get_info_filename_withpath(): got filename $filename\n"; my $infofile = $filename; # We're not modifying uploaded_files_realpath with $userdir anymore, so we can # do this processing normally (and the same way) for admins or members or strangers. # #my $userdir = get_userdir(); #if($userdir) #{ # # If get_userdir() returns a directory (i.e. if userdirs are enabled and # # a non-admin is logged in) then we need to prepend that to the infofile # # name, so that it has the correct path. This is necessary so that when # # an admin is logged in, the infofile links still work; otherwise they # # would be missing that userdir portion at the front. # $infofile = $userdir . '/' . $infofile; #} $infofile =~ s!^[/\\]+!!; # we never want a slash (which turns into "-.-.-") at the front of the filename. $infofile =~ s![/\\]{2,}!/!g; $infofile =~ s![/\\]!-.-.-!g; my $slash = $PREF{datadir} =~ m!/$! ? undef : '/'; $infofile = $PREF{datadir} . $slash . $infofile . '.info.txt'; #printd "get_info_filename_withpath(): returning filename $infofile\n"; return $infofile; } sub move_all_infofiles($$$) { my $files = shift; # arrayref [ from: my ($files, $subfolders) = get_items($srcdir); ] my $srcdir_with_url = shift; my $dstdir_with_url = shift; my @errors = (); foreach my $file (@$files) { $file = enc_untaint($file, 'keep_path'); my ($file_with_localpath_only) = ($file =~ m!$PREF{uploaded_files_realpath}/?(.+?)$!); #printd "file_with_localpath_only: $file_with_localpath_only\n"; my $old_infofile = get_info_filename_withpath($file_with_localpath_only); my ($file_with_old_path_removed) = ($file =~ /$srcdir_with_url(.+$)/); #printd "file_with_old_path_removed: $file_with_old_path_removed\n"; my $file_with_new_path_added = $dstdir_with_url . $file_with_old_path_removed; my ($newfile_with_localpath_only) = ($file_with_new_path_added =~ m!$PREF{uploaded_files_urlpath}/?(.+?)$!); #printd "newfile_with_localpath_only: $newfile_with_localpath_only\n"; my $new_infofile = get_info_filename_withpath($newfile_with_localpath_only); if(-e $old_infofile) { rename($old_infofile, $new_infofile) or push @errors, qq`couldn't move infofile from "$old_infofile" to "$new_infofile": $!`; } if($PREF{store_upload_info_in_database} =~ /yes/i) { my ($oldpath, $filename) = ($file_with_localpath_only =~ m!^(.*?/?)([^/]+)$!); my ($file_with_old_path_removed) = ($file =~ /$srcdir_with_url(.+$)/); my $file_with_new_path_added = $dstdir_with_url . $file_with_old_path_removed; my ($newfile_with_localpath_only) = ($file_with_new_path_added =~ m!$PREF{uploaded_files_urlpath}/?(.+?)$!); my $newpath = $newfile_with_localpath_only; $newpath =~ s![^/]+$!!; # remove the filename (i.e. everything from the right-end up to the slash). slashify($oldpath, $newpath); #printd "move_all_infofiles: oldpath=$oldpath, newpath=$newpath, filename=$filename\n"; sql_untaint($newpath, $filename, $oldpath); my $query = qq`UPDATE $PREF{db_table_for_upload_info} SET filepath='$newpath' WHERE filename='$filename' AND filepath='$oldpath' LIMIT 1;`; #printd "move_all_infofiles: query=$query\n"; my $sth = $PREF{dbh}->prepare($query); my $success = $sth->execute(); if(!$success || $success =~ /^(0|0E0)$/) { push(@errors, qq`couldn't update filepath from '$oldpath' to '$newpath' for filename '$filename' in upload info database: $DBI::errstr`); } } } return \@errors; } sub show_upload_session_info() { exit_with_access_denied() unless user_is_allowed_to('view_upload_info'); my %dbfields = (); foreach my $pref (keys %PREF) { if($pref =~ /^upload_session_info_url_arg_(\d+)$/) { my $num = $1; my $abbr = $PREF{$pref}; my $shortname = $PREF{"${pref}_shortname"}; $dbfields{$abbr} = $shortname; } } my %qsvars = (); foreach my $var (split(/&/, $qs)) { my ($param,$value) = ($var =~ /(.+?)=(.*)/); next if $param eq 'action'; enc_urldecode($value); $qsvars{$param} = $value; } my $statement_backend = " WHERE "; foreach my $qsvar (keys %qsvars) { sql_untaint($dbfields{$qsvar}, $qsvars{$qsvar}); $statement_backend .= "`$dbfields{$qsvar}` = '$qsvars{$qsvar}' AND "; } $statement_backend =~ s/\s*AND\s*$//; $statement_backend .= ';'; my %dbvalues = (); my $templatable_item = $PREF{upload_session_info_template}; my (@to_be_replaced, @replacement) = (); while($templatable_item =~ /(%%(.+?)%%)/g) { my ($placeholder, $var_raw, $var) = ($1, $2, undef); if($var_raw =~ /^(.+?)--/) { $var = $1; } elsif($var_raw eq 'filelist') { next; } else { $var = $var_raw; } $var = 'filepath' if $var eq 'finalpath_local'; sql_untaint($var); my $value = enc_sql_select("SELECT `$var` FROM `$PREF{db_table_for_upload_info}`" . $statement_backend); if($var_raw =~ /--date--(.+?)(--|$)/) { my $format = $1; $format =~ s/#/%/g; $value = strftime($format, localtime($value)); } if($var_raw =~ /--urlencode(--|$)/) { enc_urlencode($value); } if($var_raw =~ /--winslashes(--|$)/) { $value =~ s!/!\\!g; } # since we're outputting HTML here, replace newlines. $value =~ s!\n!
!g; push @to_be_replaced, $placeholder; push @replacement, $value; } my $k = 0; foreach my $string (@to_be_replaced) { $templatable_item =~ s/$string/$replacement[$k]/; $k++; } my $sth = $PREF{dbh}->prepare("SELECT `filepath`,`filename` FROM `$PREF{db_table_for_upload_info}`" . $statement_backend); $sth->execute() or die "$PREF{internal_appname}: show_upload_session_info(): SQL error while trying to select file info: $DBI::errstr\n"; my ($filepath, $filename, @files) = (); $sth->bind_columns(\$filepath, \$filename); while($sth->fetchrow_arrayref) { #my $href = $PREF{uploaded_files_urlpath} . $filepath . $filename; deslashify($href); $href = "/$href"; my $href = get_download_link($filepath, $filename); my $link = qq`$filename`; push @files, $link; } my $files = join "
\n", @files; $templatable_item =~ s/%%filelist%%/$files/; print_http_headers(); start_html_output() if $PREF{include_builtin_html_with_upload_session_info} =~ /yes/i; print $templatable_item; finish_html_output() if $PREF{include_builtin_html_with_upload_session_info} =~ /yes/i; } sub show_link_to_uploads { # The uploaded_files_urlpath must exist (i.e. uploaded_files_dir either must be # in the DOCROOT or else the webmaster must have set uploaded_files_urlpath # explicitly), or download_links_go_through_FileChucker must be set; and the # show_link_to_uploads... PREF must be set. return ( ( $PREF{uploaded_files_urlpath} || $PREF{download_links_go_through_FileChucker} =~ /yes/i ) && ( $PREF{show_link_to_uploads_for_strangers} =~ /yes/i || ($PREF{show_link_to_uploads_for_members} =~ /yes/i && $PREF{member_is_logged_in}) || ($PREF{show_link_to_uploads_for_admins} =~ /yes/i && $PREF{admin_is_logged_in}) ) ); } sub interpolate_vars_from_URL_and_cookies { my %url_vars = (); for(split(/&/, $qs)) { my ($var,$value) = split(/=/); enc_urldecode($value); $url_vars{$var} = $value; } s/%URL\{(.+?)\}/$url_vars{$1}/g for @_; s/%COOKIE\{(.+?)\}/get_cookie($1)/eg for @_; } # The string returned by this function must end with an ampersand (unless it's null). sub get_userdir_for_qs { my $userdir = $PREF{enable_userdirs} =~ /yes/i && $PREF{enable_userdir_on_url} =~ /yes/i ? get_userdir() : ''; $userdir = "userdir=$userdir&" if $userdir; return $userdir; } # The string returned by this function must end with an ampersand (unless it's null). sub get_path_and_userdir_for_qs { my $userdir = get_userdir_for_qs(); my ($path) = ($qs =~ /(?:^|&)path=(.*?)(?:&|$)/); my $output = (); $output .= $userdir if $userdir; $output .= "path=$path&" if $path; return $output; } sub get_textboxes { return undef unless ($PREF{store_upload_info_in_files} =~ /yes/i || $PREF{store_upload_info_in_database} =~ /yes/i); my $position = shift; my $i = shift; my $enabled = 0; my $output = (); my ($path, $file, $num_files_selected) = (); if($PREF{in_reprocessing_mode}) # redundant (with the inner if()) for clarity. { if($qs =~ /(?:^|&)path=(.*?)&ffs1=file-(.+?)(?:&|$)/) { ($path, $file) = ($1, $2); $path = '/' unless $path; enc_urldecode($path, $file); slashify($path); $path = enc_untaint($path, 'keep_path'); $file = enc_untaint($file); sql_untaint($path, $file); } foreach my $arg (split(/&/, $qs)) { $num_files_selected++ if $arg =~ /^ffs\d+=file-.+/; } } foreach my $textbox (sort keys %PREF) { if($textbox =~ /^formfield_(\d+)$/ && $PREF{"${textbox}_position"} eq $position) { my ($num) = ($1); $enabled = 1; my ($w,$h) = ($PREF{"${textbox}_size"} =~ /(\d+)x(\d+)/i); my $shortname = $PREF{"${textbox}_shortname"}; my $presetvalue = (); $presetvalue = $PREF{"${textbox}_default"} if $PREF{"${textbox}_default"}; $presetvalue = get_cookie($shortname) if ($PREF{"${textbox}_save"} =~ /yes/i && get_cookie($shortname)); $presetvalue = get_cookie($PREF{"${textbox}_fillfromcookie"}) if ($PREF{"${textbox}_fillfromcookie"} && get_cookie($PREF{"${textbox}_fillfromcookie"})); my (%reprocessing_options,$readonly) = (); if($PREF{in_reprocessing_mode}) { %reprocessing_options = map { $_ => 1 } split(/\s*,\s*/, $PREF{"${textbox}_reprocessing"}); if($reprocessing_options{skip}) { next; } if($reprocessing_options{refill}) { my $shortname = $PREF{"${textbox}_shortname"}; exit_with_error("$PREF{internal_appname}: you didn't set a _shortname PREF for the $textbox textbox.") unless $shortname; sql_untaint($shortname); # $path and $file are sql_untaint()'ed outside the foreach() loop. my $value = enc_sql_select("SELECT `$shortname` FROM `$PREF{db_table_for_upload_info}` WHERE `filepath` = '$path' AND `filename` = '$file';"); $presetvalue = $value if $value; } if($reprocessing_options{readonly}) { $readonly = qq`readonly="readonly"`; } if($reprocessing_options{fill_with_num_files_selected}) { $presetvalue = $num_files_selected; } } if($PREF{"${textbox}_before"} =~ /\S/) { $output .= $PREF{"${textbox}_before"}; } my $name = $i ? "${shortname}_$i" : $shortname; my $required = $PREF{"${textbox}_required"} =~ /yes/i ? ' required' : undef; my $emailformat = $PREF{"${textbox}_email"} =~ /yes/i ? ' emailformat' : undef; my $numeric = $PREF{"${textbox}_numeric"} =~ /yes/i ? ' numeric' : undef; $readonly = 'readonly="readonly"' if $PREF{"${textbox}_readonly"} =~ /yes/i; if($PREF{"${textbox}_custom"} =~ /yes/i) { # don't print the element here, because the user is defining it himself via the custom form prefs. } elsif($PREF{"${textbox}_dropdown"} =~ /\S/) { $output .= qq`
$PREF{$textbox}
`; $output .= qq``; $output .= qq`
\n`; } elsif($PREF{"${textbox}_checkbox"} =~ /\S/) { $output .= qq`
`; $output .= $PREF{$textbox} . $PREF{"${textbox}_label_spacer"} if $PREF{"${textbox}_labelfirst"} =~ /yes/i; $output .= qq``; $output .= $PREF{"${textbox}_label_spacer"} . $PREF{$textbox} unless $PREF{"${textbox}_labelfirst"} =~ /yes/i; $output .= qq`
\n`; } elsif($PREF{"${textbox}_radio"} =~ /\S/) { $output .= qq`
$PREF{$textbox}
`; $output .= qq`
`; my @choices = split(/\|\|\|/, $PREF{"${textbox}_radio"}); my @radio = (); foreach my $choice (@choices) { my $button = (); $button = $choice . $PREF{"${textbox}_label_spacer"} if $PREF{"${textbox}_labelfirst"} =~ /yes/i; $button .= qq``; $button .= $PREF{"${textbox}_label_spacer"} . $choice unless $PREF{"${textbox}_labelfirst"} =~ /yes/i; push @radio, $button; } $output .= join $PREF{"${textbox}_item_separator"}, @radio; $output .= qq`
\n`; $output .= qq`
\n`; $output .= qq`
\n`; } elsif($PREF{"${textbox}_hidden"} =~ /\S/) { $output .= qq`\n`; } elsif($PREF{"${textbox}_multiline"} =~ /yes/i) { $output .= qq`
$PREF{$textbox}
\n`; } else { if($reprocessing_options{hide}) { $output .= qq`\n`; } else { $output .= qq`
$PREF{$textbox}
\n`; } } if($PREF{"${textbox}_after"} =~ /\S/) { $output .= $PREF{"${textbox}_after"}; } } } my $textboxes = (); if($enabled) { $textboxes = qq`
\n`; $textboxes .= qq`\t
$PREF{"${position}_formfields_title"}
\n` if $PREF{"${position}_formfields_title"} =~ /\S/; if($PREF{in_replace_mode}) { $textboxes .= qq`

In Replace Mode; using existing values.

\n`; } if($PREF{in_addfile_mode}) { $textboxes .= qq`

In AddFile Mode; using existing values.

\n`; } else { $textboxes .= $output; } $textboxes .= qq`
\n\n\n`; return $textboxes; } else { return undef; } } sub get_textbox_values { my $mode = shift; # top, bottom, perfile, or all. my $i = shift; $i = '\d+' if !$i && $mode eq 'all'; my $textboxes = shift; # hashref. my $format = shift; my $newline = $format eq 'html' ? '
' : "\n"; my $show_field_keynames = shift; $show_field_keynames = $show_field_keynames eq 'show_field_keynames' ? 1 : 0; my $replace_NEWLINEs = shift; $replace_NEWLINEs = $replace_NEWLINEs eq 'replace_NEWLINEs' ? 1 : 0; my $mark_headings = shift; $mark_headings = $mark_headings eq 'mark_headings' ? 1 : 0; my $output = (); foreach my $location ('top', 'perfile', 'bottom') { if($mode =~ /^($location|all)$/) { if($PREF{"${location}_formfields_title"} =~ /\S/) { $output .= qq`${location}_formfields_title: ` if $show_field_keynames; if($mark_headings) { $output .= $newline eq "\n" ? '=' x 70 . "\n" . $PREF{"${location}_formfields_title"} . "\n" . '=' x 70 . "\n\n" : '

' . $PREF{"${location}_formfields_title"} . '

'; } else { $output .= $PREF{"${location}_formfields_title"}; } } foreach my $tb (sort keys %$textboxes) { my ($tbname,$filenum) = ($tb =~ /^(.+)_(\d+)$/); if( #( $mode =~ /^(top|bottom|all)$/ && ($tb =~ /^${location}_textbox_\d+_(single|multi)line$/ ) ( $mode =~ /^(top|bottom|all)$/ && ($tb =~ /^formfield_\d+$/ && $PREF{"${tb}_position"} eq $location) ) || #( $mode =~ /^(perfile|all)$/ && ($tb =~ /^${location}_textbox_\d+_(single|multi)line_$i$/ ) ) ( $mode =~ /^(perfile|all)$/ && (($tb =~ /^formfield_\d+_$i$/ && $PREF{"${tbname}_position"} eq $location) ) ) ) { $output .= $newline . $newline unless $mark_headings; $output .= qq`$tb:name: ` if $show_field_keynames; if($mark_headings && $$textboxes{$tb}{name}) { $output .= $newline eq "\n" ? $$textboxes{$tb}{name} . "\n\n" : '

' . $$textboxes{$tb}{name} . '

'; } else { $output .= $$textboxes{$tb}{name}; } $output .= $newline . $newline unless $mark_headings; $output .= qq`$tb:value: ` if $show_field_keynames; if($PREF{"${tb}_checkbox"} =~ /yes/i) { $$textboxes{$tb}{value} = $$textboxes{$tb}{value} =~ /^(on|yes|checked)$/i ? 'yes' : 'no'; } $output .= $$textboxes{$tb}{value} . $newline . $newline; $output .= '-' x 50 . "\n\n" if $mark_headings && $newline eq "\n"; } } $output .= $newline . $newline if $output; } } $output =~ s/::NEWLINE::/$newline/g if $replace_NEWLINEs; # Note that this function is written so that output is null if none of # the appropriate PREFs are set. return $output; } sub get_textbox_pref_keys() { my %keys = (); foreach my $location (@_) { foreach my $key (keys %PREF) { if($key =~ /^formfield_(\d+)$/) { $keys{$1} = $key if ($PREF{"${key}_position"} eq $location); } } } my @keys = (); foreach my $num (sort { $a <=> $b } keys %keys) { push @keys, $keys{$num}; } return @keys; } sub get_formfield_key_from_shortname($) { my $shortname = shift; foreach my $key (keys %PREF) { if($key =~ /^(formfield_\d+)_shortname$/ && $PREF{$key} eq $shortname) { return $1; } } #exit_with_error("Error: get_formfield_key_from_shortname('$shortname'): no key has that shortname.\n"); warn "Error: get_formfield_key_from_shortname('$shortname'): no key has that shortname.\n"; } sub download_file { exit_with_access_denied() unless user_is_allowed_to('download'); my $path = shift; my $file = shift; enc_urldecode($path, $file); $file = enc_untaint($file); $path = enc_untaint($path, 'keep_path') if $path; exit_with_error("Insufficient permissions to download file.") unless get_effective_folder_permissions($PREF{logged_in_username}, $path) =~ /^r[ow]$/i; my $fullfile = "$PREF{uploaded_files_realpath}/$path/$file"; condense_slashes('leave_leading_UNC', $fullfile); select STDOUT; $| = 1; my ($read,$buf) = (); my $size = (stat $fullfile)[7]; print qq`Content-Type: application/octet-stream\n` . qq`Content-Disposition: attachment; filename=$file\n` . qq`Content-Length: $size\n` . qq`Content-Description: Downloadable File\n\n`; open(DOWNLOADFILEFH, $fullfile) or die "$0: couldn't open file '$fullfile' for reading: $!\n"; my $infh = \*DOWNLOADFILEFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". binmode $infh; my $blocksize = (stat $infh)[11] ? (stat $infh)[11] : 16384; while($read = sysread($infh, $buf, $blocksize)) { unless(defined($read)) { next if $! =~ /^Interrupted/; die "$0: download_file(): read error: $!\n"; } my ($written,$offset) = (0,0); while($read) { $written = syswrite(STDOUT, $buf, $read, $offset); unless(defined($written)) { die "$0: download_file(): write error: $!\n"; } $read -= $written; $offset += $written; } } close $infh or die "$0: couldn't close file '$fullfile' after reading: $!\n"; if($PREF{update_timestamp_on_download} =~ /yes/i) { use ExtUtils::Command 'touch'; local @ARGV = (); push @ARGV, $fullfile; touch; # modifies only items in @ARGV. } } sub get_uploaded_files_url_path { my $arg = shift || ''; my $strip_trailing_slash = $arg eq 'without_trailing_slash' ? 1 : 0; if($PREF{hide_path_to_uploads_dir} =~ /yes/i) { return undef; } else { my $path = $PREF{uploaded_files_urlpath}; $path =~ s!/+$!! if $strip_trailing_slash; return $path; } } sub print_size_error { my $error = shift; my $size = shift; my $limit = shift; start_html_output('Error', 'css'); my $upload_size = format_filesize_nicely($size); my $nice_limit = format_filesize_nicely($limit); if($error eq 'toobig') { print qq`

Error:

You tried to send $upload_size, but the owner of this site has set the limit to $nice_limit.

\n`; } elsif($error eq 'globalquotaexceeded') { print qq`

Error:

You tried to send $upload_size, which would have expanded the upload directory beyond its global quota of $nice_limit.

\n`; } elsif($error eq 'userquotaexceeded') { print qq`

Error:

You tried to send $upload_size, which would have expanded your upload directory beyond its quota of $nice_limit.

\n`; } finish_html_output('home'); } sub unzip_files { my $query = new CGI(); start_html_output('Unzipping...', 'css', 'js'); print_http_headers(); print "todo\n"; finish_html_output('home'); } ##### sub print_notadmin_error_with_link_to_login_page() { print qq`

You must login as an administrator to use that facility.

\n`; } sub get_image_dims { my $filename = shift; if($PREF{imagemagick_available} =~ /yes/i) { my $image = new Image::Magick; my ($width, $height, $size, $format) = $image->Ping($filename); return ($width, $height); } elsif($PREF{gd_available} =~ /yes/i) { my $image = GD::Image->new($filename); return ($image->width, $image->height) if $image; } } sub resize_image { my $infile = shift; my $outfile = shift; my $newW = shift; my $newH = shift; my $geom = (); if($newW =~ /(\d*)x(\d*)!?/i) { $geom = $newW; ($newW,$newH) = ($1,$2); } else { $geom = $newW . 'x' . $newH; } die_nice "$PREF{internal_appname}: can't resize image because at least one of the dimensions must be specified (\$newW='$newW', \$newH='$newH')\n" unless ($newW =~ /[1-9]/ || $newH =~ /[1-9]/); if($PREF{convert_available} =~ /yes/i && $PREF{try_to_use_convert_for_resizing} =~ /yes/i) { printd qq`resize_image(): using convert\n`; my $cmd = qq`$PREF{convert_command} -filter lanczos -size ${newW}x${newH} -resize ${newW}x${newH} -quality 95 "$infile" "$outfile"`; my ($success,$msg) = enc_sys_call($cmd); unless($success) { die_nice(qq`$PREF{internal_appname}: resize_image() failed: $msg`); } } elsif($PREF{imagemagick_available} =~ /yes/i && $PREF{try_to_use_imagemagick_for_resizing} =~ /yes/i) { printd qq`resize_image(): using IM\n`; my $image = new Image::Magick; my $retval = (); $retval = $image->Read($infile); if($retval) { print STDERR "$0: error: resize_image(): \$image->Read() returned $retval.\n"; return; } $retval = $image->Resize(geometry=>$geom, filter=>'Lanczos'); if($retval) { print STDERR "$0: error: resize_image(): \$image->Resize() returned $retval.\n"; return; } $image->Set(quality=>95); $image->Write($outfile); } elsif($PREF{gd_available} =~ /yes/i && $PREF{try_to_use_gd_for_resizing} =~ /yes/i) { printd qq`resize_image(): using GD\n`; my $inputimage = GD::Image->new($infile); if(!$inputimage) { print STDERR "$0: error: resize_image(): GD::Image->new($infile) returned null...\n"; return; } my $oldW = $inputimage->width; my $oldH = $inputimage->height; die "$0: can't resize image because a dimension is missing (\$oldW='$oldW', \$oldH='$oldH')\n" unless $oldW =~ /[1-9]/ && $oldH =~ /[1-9]/; if(!$newW) { $newW = ($newH * $oldW) / $oldH; $newW =~ s/\..*//; } if(!$newH) { $newH = ($newW * $oldH) / $oldW; $newH =~ s/\..*//; } my $outputimage = GD::Image->newTrueColor($newW,$newH); $outputimage->copyResampled($inputimage,0,0,0,0,$newW,$newH,$oldW,$oldH); open(RESIMG, ">$outfile") or die "$0: couldn't create file '$outfile': $!\n"; my $fh = \*RESIMG; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". binmode $fh; if($outfile =~ /\.jpe?g$/i) { print $fh $outputimage->jpeg(95); } elsif($outfile =~ /\.png$/i) { print $fh $outputimage->png(3); } elsif($outfile =~ /\.gif$/i) { print $fh $outputimage->gif(); } else { die "$0: resize_image(): image format not supported by GD.\n"; } close $fh or die "$0: couldn't close file '$outfile' after creating it: $!\n"; } else { die_nice "$PREF{internal_appname}: resize_image(): no image-resizing library available."; } } sub rotate_images($$) { my ($degrees, $path) = @_; enc_urldecode($path); my ($query, %params) = (); if($qs =~ /(?:^|&)mode=single&name=(.+?)(?:&|$)/) { $params{$1} = 1; enc_urldecode($params{$1}); } else { $query = new CGI(); # must happen if we were POSTed to, or there's a weird delay between client/server after the script finishes. %params = $query->Vars; } exit_with_error("Error: access denied.") unless user_is_allowed_to('rotate_images'); my $fullpath = "$PREF{uploaded_files_realpath}/$path/"; condense_slashes('leave_leading_UNC', $fullpath); foreach my $param(sort keys %params) { #print "$param: $params{$param}
\n"; if(my ($filename) = ($param =~ /^file-(.+)/)) { my $infile = my $outfile = "$fullpath$filename"; my $thumb = "$fullpath$PREF{filelist_thumbnail_dir_name}/$filename"; rotate_image($infile, $outfile, $degrees); make_thumbnail($outfile, $thumb); } } enc_redirect($ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here}?action=listfiles"); } sub make_thumbnail($$) { my ($image_file, $thumb) = @_; my ($output_dir) = ($thumb =~ m!(.*)[/\\]!); create_dir_if_DNE($output_dir,$PREF{writable_dir_perms_as_octal}) if $output_dir; my $thumbsize = $PREF{imagemagick_available} =~ /yes/i || $PREF{try_to_use_convert_for_resizing} =~ /yes/i ? $PREF{filelist_thumbnail_size__imagemagick} : $PREF{gd_available} =~ /yes/i ? $PREF{filelist_thumbnail_size__gd} : ''; my ($origw,$origh) = get_image_dims($image_file); my ($thumbw,$thumbh) = ($thumbsize =~ /^(\d*)x?(\d*)$/i); if($origw > $thumbw || $origh > $thumbh || !$origw || !$thumbw) { resize_image($image_file, $thumb, $thumbsize); } else { copy($image_file, $thumb) or die "$0: couldn't copy image file '$image_file' to thumbnail file '$thumb': $!\n"; } chmod 0666, $thumb; } sub rotate_image($$$) { my ($infile,$outfile,$degrees) = @_; return unless $infile =~ /$PREF{rotatable_image_extensions}/i; if($PREF{jpegtran_available} =~ /yes/i && $PREF{try_to_use_jpegtran_for_rotation} =~ /yes/i && $infile =~ /\.(jpg|jpe|jpeg)$/i) { printd qq`rotate_image(): using JT\n`; my $cmd = qq`$PREF{jpegtran_command} -rotate $degrees -copy all -outfile $outfile $infile`; my ($success,$msg) = enc_sys_call($cmd); unless($success) { die_nice(qq`$PREF{internal_appname}: rotate_image() failed: $msg`); } } elsif($PREF{convert_available} =~ /yes/i && $PREF{try_to_use_convert_for_rotation} =~ /yes/i) { printd qq`rotate_image(): using convert\n`; my $cmd = qq`$PREF{convert_command} -filter lanczos -quality 95 -rotate $degrees "$infile" "$outfile"`; my ($success,$msg) = enc_sys_call($cmd); unless($success) { die_nice(qq`$PREF{internal_appname}: resize_image() failed: $msg`); } } elsif($PREF{imagemagick_available} =~ /yes/i && $PREF{try_to_use_imagemagick_for_rotation} =~ /yes/i) { printd qq`rotate_image(): using IM\n`; my $image = new Image::Magick; my $retval = (); $retval = $image->Read($infile); if($retval) { print STDERR "$0: error: rotate_image(): \$image->Read() returned $retval.\n"; return; } $retval = $image->Rotate(degrees=>$degrees); if($retval) { print STDERR "$0: error: rotate_image(): \$image->Rotate() returned $retval.\n"; return; } $image->Set(quality=>100); $image->Write($outfile); } elsif($PREF{gd_available} =~ /yes/i && $PREF{try_to_use_gd_for_rotation} =~ /yes/i) { printd qq`rotate_image(): using GD\n`; my $inputimage = GD::Image->newTrueColor($infile); if(!$inputimage) { warn "$0: error: rotate_image(): GD::Image->new($infile) returned null...\n"; return; } my $outputimage = (); if($degrees == 90) { $outputimage = $inputimage->copyRotate90(); } elsif($degrees == 180) { $outputimage = $inputimage->copyRotate180(); } elsif($degrees == 270) { $outputimage = $inputimage->copyRotate270(); } my ($extension) = ($outfile =~ /\.(\w+)$/); my $tempfilename = enc_hash($outfile . time) . '.fctemp.' . $extension; my $tempfile = "$PREF{datadir}/$tempfilename"; open(ROTIMG, ">$tempfile") or die "$0: couldn't create file '$tempfile': $!\n"; my $fh = \*ROTIMG; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". binmode $fh; if($outfile =~ /\.jpe?g$/i) { print $fh $outputimage->jpeg(100); } elsif($outfile =~ /\.png$/i) { print $fh $outputimage->png(1); } elsif($outfile =~ /\.gif$/i) { print $fh $outputimage->gif(); } else { die "$0: rotate_image(): image format not supported by GD.\n"; } close $fh or die "$0: couldn't close file '$tempfile' after creating it: $!\n"; if(!rename($tempfile, $outfile)) { unlink $tempfile; die_nice(qq`$PREF{internal_appname}: rotate_image($infile, $outfile, $degrees): couldn't rename tempfile ('$tempfile') to final file ('$outfile'): $!\n`); } } else { die_nice "$PREF{internal_appname}: no image-rotating library available...\n"; } } sub is_image { my $file = shift; return $file =~ /$PREF{filelist_thumbnail_image_extensions}/i; } sub force_update_of_thumbs_cache { if(user_is_allowed_to('force_update_of_thumbs_cache')) { if($qs =~ /makethumbs=1/) { return 1; } } } sub find_first_image_in_dir { my $dir = shift; my $sizelimit = shift; return unless -d $dir; my @all_dirs = ($dir); my @all_subdirs = get_all_subdirs($dir); for(@all_subdirs) { push @all_dirs, $dir . '/' . $_; } foreach my $subdir (@all_dirs) { # don't use images from our own thumbnail folders. next if $subdir =~ m!(^|/|\\)$PREF{filelist_thumbnail_dir_name}(/|\\|$)!; opendir(SCANDIRFH, $subdir) or die "$0: 22 couldn't open directory $subdir: $!\n"; my $dirh = \*SCANDIRFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". my @files = sort grep { ! -d "$subdir/$_" } readdir($dirh); closedir $dirh or die "$0: couldn't close directory $subdir: $!\n"; for(@files) { if(is_image($_)) { return "$subdir/$_" if (!$sizelimit || -s "$subdir/$_" < $sizelimit); } } } } sub jpegtran_is_available() { $PREF{jpegtran_test_command} = 'jpegtran /dev/null 2>&1'; my ($success,$msg) = enc_sys_call($PREF{jpegtran_test_command}); if($success) { $PREF{jpegtran_available} = 'yes'; $PREF{jpegtran_error} = ''; } else { $PREF{jpegtran_available} = 'no'; $PREF{jpegtran_error} = "Failed to execute jpegtran: $msg"; } return !$PREF{jpegtran_error}; } sub imagemagick_is_available() { eval { require Image::Magick; }; $PREF{imagemagick_error} = $@; $PREF{imagemagick_available} = $PREF{imagemagick_error} ? 'no' : 'yes'; return !$PREF{imagemagick_error}; } sub gd_is_available() { eval { require GD; require GD::Simple; }; $PREF{gd_error} = $@; $PREF{gd_available} = $PREF{gd_error} ? 'no' : 'yes'; return !$PREF{gd_error}; } sub image_thumbnails_possible() { return ($PREF{imagemagick_available} =~ /yes/i && $PREF{try_to_use_imagemagick_for_resizing} =~ /yes/i || $PREF{gd_available} =~ /yes/i && $PREF{try_to_use_gd_for_resizing} =~ /yes/i || $PREF{convert_available} =~ /yes/i && $PREF{try_to_use_convert_for_resizing} =~ /yes/i); } #sub image_thumbnail_prefs_enabled() { return ($PREF{enable_file_thumbnails_in_filelist} =~ /yes/i || $PREF{enable_folder_thumbnails_in_filelist} =~ /yes/i); } sub image_rotation_possible { my $file = shift; return ( $PREF{imagemagick_available} =~ /yes/i && $PREF{try_to_use_imagemagick_for_rotation} =~ /yes/i || $PREF{gd_available} =~ /yes/i && $PREF{try_to_use_gd_for_rotation} =~ /yes/i || $PREF{convert_available} =~ /yes/i && $PREF{try_to_use_convert_for_rotation} =~ /yes/i || $PREF{jpegtran_available} =~ /yes/i && $PREF{try_to_use_jpegtran_for_rotation} =~ /yes/i && (!$file || $file =~ /\.jp(e|g|eg)$/i) ); } #sub image_rotation_prefs_enabled() { return ($PREF{enable_rotate90_action} || $PREF{enable_rotate180_action} || $PREF{enable_rotate270_action}); } sub image_humantest_possible() { return ($PREF{imagemagick_available} =~ /yes/i && $PREF{try_to_use_imagemagick_for_humantest} =~ /yes/i || $PREF{gd_available} =~ /yes/i && $PREF{try_to_use_gd_for_humantest} =~ /yes/i); } #sub image_humantest_prefs_enabled() { return ($PREF{enable_human_test} =~ /yes/i); } sub file_thumbnails_enabled() { my $enabled = 0; if($PREF{enable_file_thumbnails_in_filelist} =~ /yes/i) { if($PREF{image_thumbnails_on_by_default} =~ /yes/i) { unless($PREF{visitors_can_toggle_thumbnails_on_and_off} =~ /yes/i && $PREF{file_thumbnail_cookie_disabled}) { $enabled = 1; } } else { if($PREF{visitors_can_toggle_thumbnails_on_and_off} =~ /yes/i && $PREF{file_thumbnail_cookie_enabled}) { $enabled = 1; } } } return $enabled; } sub folder_thumbnails_enabled() { my $enabled = 0; if($PREF{enable_folder_thumbnails_in_filelist} =~ /yes/i) { if($PREF{folder_thumbnails_on_by_default} =~ /yes/i) { unless($PREF{visitors_can_toggle_thumbnails_on_and_off} =~ /yes/i && $PREF{folder_thumbnail_cookie_disabled}) { $enabled = 1; } } else { if($PREF{visitors_can_toggle_thumbnails_on_and_off} =~ /yes/i && $PREF{folder_thumbnail_cookie_enabled}) { $enabled = 1; } } } return $enabled; } sub create_perms_table_if_DNE { my $table = (); my $table_exists = 0; my $sth = $PREF{dbh}->prepare(qq`show tables;`); $sth->execute(); $sth->bind_columns(\$table); while($sth->fetchrow_arrayref) { if($table eq $PREF{perms_table_name}) { $table_exists = 1; last; } } if( ! $table_exists ) { print STDERR "$0: table $PREF{perms_table_name} does not exist; attempting to create it now.\n"; my $statement = "CREATE TABLE `$PREF{perms_table_name}` (" . " `id` BIGINT NOT NULL AUTO_INCREMENT PRIMARY KEY, " . " `path` TEXT NOT NULL, " . " `rousers` TEXT, " . " `rogroups` TEXT, " . " `rwusers` TEXT, " . " `rwgroups` TEXT " . ")"; $sth = $PREF{dbh}->prepare($statement); $sth->execute() or die_nice("$0: couldn't create table '$PREF{perms_table_name}': $DBI::errstr\n"); print STDERR "$0: created table $PREF{perms_table_name} successfully.\n"; } } sub custom_folder_perms_enabled { return ($PREF{enable_custom_folder_permissions} =~ /yes/i); } sub show_permissions($) { my $item = shift; slashify($item); exit_with_error("Access denied: insufficient permissions to access this page.") unless logged_in_user_has_permission_to_view_perms($item); exit_with_error("This feature is not enabled.") unless custom_folder_perms_enabled(); my $realpath_to_item = $PREF{uploaded_files_realpath} . '/' . $item; slashify($realpath_to_item); exit_with_error("That directory does not exist.") unless -d $realpath_to_item; start_html_output("Permissions for $item", 'css'); print qq`

Permissions for $item

\n`; my $parent = $item; remove_deepest_level($parent); my $parentlink = qq`parent folder`; my $parentpermslink = qq`parent permissions`; my $allpermslink = qq`all permissions`; my $showparentlink = folder_is_allowed_to_be_displayed($parent) && $parent ne $item; my $showparentpermslink = logged_in_user_has_permission_to_view_perms($parent) && $parent ne $item; my $showallpermslink = $PREF{admin_is_logged_in}; my @toplinks = (); push (@toplinks, $parentlink) if $showparentlink; push (@toplinks, $parentpermslink) if $showparentpermslink; push (@toplinks, $allpermslink) if $showallpermslink; if(@toplinks) { print qq`

( `; print join " – ", @toplinks; print qq` )

`; } my %users_with_perms = (); if(userbase_available()) { foreach my $level ('rw', 'ro') { if(my $users = get_users_with_direct_access_to_item($level, $item)) { foreach my $uid (split(/,/, $users)) { my $username = get_user_name($uid); $users_with_perms{$username}{id} = $uid; $users_with_perms{$username}{$level}{direct} = 1; } } if(my $users = get_users_with_inherited_access_to_item($level, $item)) { foreach my $uid (split(/,/, $users)) { my $username = get_user_name($uid); $users_with_perms{$username}{id} = $uid; $users_with_perms{$username}{$level}{inherited} = 1; } } } } my %groups_with_perms = (); foreach my $level ('rw', 'ro') { if(my $groups = get_groups_with_direct_access_to_item($level, $item)) { foreach my $gid (split(/,/, $groups)) { my $groupsname = get_group_name($gid); $groups_with_perms{$groupsname}{id} = $gid; $groups_with_perms{$groupsname}{$level}{direct} = 1; } } if(my $groups = get_groups_with_inherited_access_to_item($level, $item)) { foreach my $gid (split(/,/, $groups)) { my $groupsname = get_group_name($gid); $groups_with_perms{$groupsname}{id} = $gid; $groups_with_perms{$groupsname}{$level}{inherited} = 1; } } } my $letter = $qs =~ /(?:^|&)which=([a-z])(?:&|$)/i ? $1 : $qs =~ /(?:^|&)which=all(?:&|$)/i ? 'all' : 'all'; my $editable = logged_in_user_has_permission_to_change_perms($item); print qq`
\n`; print qq`\n`; print qq`\n`; print qq`\n\n`; my $some_perms_set = 0; my $i = 0; foreach my $group (sort { lc($a) cmp lc($b) } keys %groups_with_perms) { next if $group =~ /^$PREF{admin_group_name}$/i; # admins always have full access. if(userbase_available()) { next unless display_group_on_perms_page_for_loggedin_user($group,$item); } else { next unless $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i; } my $rocheckbox = qq``; my $rwcheckbox = qq``; if($groups_with_perms{$group}{ro}{inherited} && $groups_with_perms{$group}{rw}{inherited}) { if(find_closest_inherited_permissions_for_id('group', $groups_with_perms{$group}{id}, $item) =~ /^ro/) { $groups_with_perms{$group}{rw}{inherited} = 0; } else { $groups_with_perms{$group}{ro}{inherited} = 0; } } my $inh_ro = $groups_with_perms{$group}{ro}{inherited} ? '(inh)' : undef; my $inh_rw = $groups_with_perms{$group}{rw}{inherited} ? '(inh)' : undef; my $group_display = $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i ? "$group" : $group; print qq`\n`; $some_perms_set = 1; } if(userbase_available() && display_user_on_perms_page_for_loggedin_user($item)) { foreach my $user (sort { lc($a) cmp lc($b) } keys %users_with_perms) { next if is_admin($users_with_perms{$user}{id}); # admins always have full access. my $rocheckbox = qq``; my $rwcheckbox = qq``; if($users_with_perms{$user}{ro}{inherited} && $users_with_perms{$user}{rw}{inherited}) { if(find_closest_inherited_permissions_for_id('user', $users_with_perms{$user}{id}, $item) =~ /^ro/) { $users_with_perms{$user}{rw}{inherited} = 0; } else { $users_with_perms{$user}{ro}{inherited} = 0; } } my $inh_ro = $users_with_perms{$user}{ro}{inherited} ? '(inh)' : undef; my $inh_rw = $users_with_perms{$user}{rw}{inherited} ? '(inh)' : undef; print qq`\n`; $some_perms_set = 1; } } print qq`\n\n` unless $some_perms_set; if($editable) { print qq`\n\n`; my $some_rows_displayed = 0; my $restriction = ($letter eq 'all' || !userbase_available()) ? undef : " WHERE LOWER(`group`) LIKE LOWER('$letter%') "; my %allgroups = (); if(userbase_available()) { my ($gid,$group) = (); my $sth = $PREF{dbh}->prepare("SELECT `id`,`group` FROM `$PREF{group_table_name}`${restriction}ORDER BY `group`"); $sth->execute() or die_nice("$0: show_permissions() failed: $DBI::errstr\n"); $sth->bind_columns(\$gid,\$group); while($sth->fetchrow_arrayref) { $allgroups{$group} = $gid; } } else { $allgroups{$PREF{public_group_name}} = -1; $allgroups{$PREF{member_group_name}} = -2; # don't process the admin group here since admins always have full access. } foreach my $group (sort keys %allgroups) { my $gid = $allgroups{$group}; unless($groups_with_perms{$group}) { next if $group =~ /^$PREF{admin_group_name}$/i; # admins always have full access. if(userbase_available()) { next unless display_group_on_perms_page_for_loggedin_user($group,$item); } else { next unless $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i; } my $rocheckbox = qq``; my $rwcheckbox = qq``; my $group_display = $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i ? "$group" : $group; print qq`\n`; $some_rows_displayed = 1; } } if(userbase_available() && display_user_on_perms_page_for_loggedin_user($item)) { $restriction = $letter eq 'all' ? undef : " WHERE LOWER(`username`) LIKE LOWER('$letter%') "; my ($uid,$user) = (); my $sth = $PREF{dbh}->prepare("SELECT `id`,`username` FROM `$PREF{user_table_name}`${restriction}ORDER BY `username`"); $sth->execute() or die_nice("$0: show_permissions() failed: $DBI::errstr\n"); $sth->bind_columns(\$uid,\$user); while($sth->fetchrow_arrayref) { unless($users_with_perms{$user}) { next if is_admin($uid); # admins always have full access. my $rocheckbox = qq``; my $rwcheckbox = qq``; print qq`\n`; $some_rows_displayed = 1; } } } print qq`\n\n` unless $some_rows_displayed; print qq`\n\n`; } print qq`\n
NameRead-Only
Access
Read/Write
Access
` . (userbase_available() ? 'All users/groups' : 'Groups') . qq` with permissions set on this folder:
Group $group_display$rocheckbox RO $inh_ro$rwcheckbox RW $inh_rw
User $user$rocheckbox RO $inh_ro$rwcheckbox RW $inh_rw
(none)
` . (userbase_available() ? 'Users/Groups' : 'Groups') . qq` with no permissions set on this folder` . (userbase_available() ? qq` (filter: '$letter')` : undef) . qq`:
Group $group_display$rocheckbox RO$rwcheckbox RW
User $user$rocheckbox RO$rwcheckbox RW
(none)
\n
\n`; if($editable && userbase_available()) { print qq`

\nFilter users/groups with no permissions:
All`; foreach my $char ('A'..'Z') { print qq`$char`; } print qq`\n

`; } my $user_vs_group = $PREF{user_perms_override_group_perms_for_same_folder} =~ /yes/i ? 'User permissions override group permissions' : 'Group permissions override user permissions'; print qq`\n

Notes: (inh) indicates a permission inherited from a parent folder.  Permissions set directly on this folder override any inherited permissions.  `; print qq`$user_vs_group when both apply to the same folder.  ` if userbase_available(); print qq`If no permissions have been set (direct or inherited) then the default access level is '$PREF{default_folder_rights}'.

`; finish_html_output('home', 'uploader', 'list'); } sub change_permissions() { die_nice("You must POST to get here...\n") unless $ENV{REQUEST_METHOD} =~ /post/i; exit_with_error("This feature is not enabled.") unless custom_folder_perms_enabled(); use CGI 'param'; my $item = param('item'); slashify($item); #exit_with_error("You must be an admin to do that.") unless $PREF{admin_is_logged_in}; exit_with_error("Access denied: insufficient permissions to access this page.") unless logged_in_user_has_permission_to_change_perms($item); my $rogroups = get_groups_with_direct_access_to_item('ro', $item); my $rwgroups = get_groups_with_direct_access_to_item('rw', $item); my $rousers = get_users_with_direct_access_to_item('ro', $item); my $rwusers = get_users_with_direct_access_to_item('rw', $item); my $groups = get_groups_hash(); foreach my $group (sort keys %$groups) { if(userbase_available()) { next unless display_group_on_perms_page_for_loggedin_user($group,$item); } else { next unless $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i; } my $gid = $$groups{$group}{id}; if($rogroups && $rogroups =~ /(^|,)$gid(,|$)/ && param("group-$gid-ro") !~ /on/i) { remove_access_from_item('groups', $gid, $item, 'ro'); } elsif($rogroups !~ /(^|,)$gid(,|$)/ && param("group-$gid-ro") =~ /on/i) { add_access_to_item('groups', $gid, $item, 'ro'); } if($rwgroups && $rwgroups =~ /(^|,)$gid(,|$)/ && param("group-$gid-rw") !~ /on/i) { remove_access_from_item('groups', $gid, $item, 'rw'); } elsif($rwgroups !~ /(^|,)$gid(,|$)/ && param("group-$gid-rw") =~ /on/i) { add_access_to_item('groups', $gid, $item, 'rw'); } } if(userbase_available() && display_user_on_perms_page_for_loggedin_user($item)) { my ($uid,$user) = (); my $sth = $PREF{dbh}->prepare("SELECT `id`,`username` FROM `$PREF{user_table_name}`"); $sth->execute() or die_nice("$0: change_permissions() failed: $DBI::errstr\n"); $sth->bind_columns(\$uid,\$user); while($sth->fetchrow_arrayref) { if($rousers && $rousers =~ /(^|,)$uid(,|$)/ && param("user-$uid-ro") !~ /on/i) { remove_access_from_item('users', $uid, $item, 'ro'); } elsif($rousers !~ /(^|,)$uid(,|$)/ && param("user-$uid-ro") =~ /on/i) { add_access_to_item('users', $uid, $item, 'ro'); } if($rwusers && $rwusers =~ /(^|,)$uid(,|$)/ && param("user-$uid-rw") !~ /on/i) { remove_access_from_item('users', $uid, $item, 'rw'); } elsif($rwusers !~ /(^|,)$uid(,|$)/ && param("user-$uid-rw") =~ /on/i) { add_access_to_item('users', $uid, $item, 'rw'); } } } enc_redirect($ENV{HTTP_REFERER}); } sub display_group_on_perms_page_for_loggedin_user($$) { my $group = shift; my $item = shift; if($PREF{admin_is_logged_in}) { return 1; } elsif($group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i) { return 1; } elsif($PREF{users_changing_userdir_perms_can_see_other_groups} =~ /yes/i) { if($PREF{users_can_change_perms_in_own_userdir} =~ /yes/i) { # TODO: should we remove userbase_available() from this check, so this works for serial-userdirs too? # return 1 if ($PREF{enable_userdirs} =~ /yes/i && userbase_available() && $PREF{userdir} && $item =~ m!^/$PREF{userdir_folder_name}/$PREF{userdir}(/|$)!); } } else { return 0; } } sub display_user_on_perms_page_for_loggedin_user($) { my $item = shift; if($PREF{admin_is_logged_in}) { return 1; } elsif($PREF{users_changing_userdir_perms_can_see_other_users} =~ /yes/i) { if($PREF{users_can_change_perms_in_own_userdir} =~ /yes/i) { # TODO: should we remove userbase_available() from this check, so this works for serial-userdirs too? # return 1 if ($PREF{enable_userdirs} =~ /yes/i && userbase_available() && $PREF{userdir} && $item =~ m!^/$PREF{userdir_folder_name}/$PREF{userdir}(/|$)!); } } else { return 0; } } sub remove_access_from_item($$$$) { my ($type, $id, $item, $level) = @_; slashify($item); sql_untaint($item); check_id_for_sql_safeness($id); my $list = enc_sql_select("SELECT `${level}${type}` FROM `$PREF{perms_table_name}` WHERE `path` = '$item'"); $list =~ s/(^|,)($id)(,|$)/$1$3/; decommaify($list); my $statement = "UPDATE `$PREF{perms_table_name}` SET `${level}${type}` = '$list' WHERE `path` = '$item'"; my $sth = $PREF{dbh}->prepare($statement); $sth->execute() or die_nice("$0: remove_access_from_item('$type', '$id', '$item', '$level') failed: $DBI::errstr\n"); } sub add_access_to_item($$$$) { my ($type, $id, $item, $level) = @_; create_record_for_item_if_DNE($item); slashify($item); sql_untaint($item); check_id_for_sql_safeness($id); my $existinglist = enc_sql_select("SELECT `${level}${type}` FROM `$PREF{perms_table_name}` WHERE `path` = '$item'"); my $newlist = $existinglist . ',' . $id; $newlist =~ s/^,+//; my $statement = "UPDATE `$PREF{perms_table_name}` SET `${level}${type}` = '$newlist' WHERE `path` = '$item'"; my $sth = $PREF{dbh}->prepare($statement); $sth->execute() or die_nice("$0: add_access_to_item('$type', '$id', '$item', '$level') failed: $DBI::errstr\n"); # and since RO and RW are mutually exclusive, we now must remove the other one. my $oldlevel = $level =~ /^ro$/i ? 'rw' : 'ro'; remove_access_from_item($type, $id, $item, $oldlevel); } sub create_record_for_item_if_DNE($) { my $item = shift; slashify($item); sql_untaint($item); if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{perms_table_name}` WHERE `path` = '$item'") < 1) { my $statement = "INSERT INTO `$PREF{perms_table_name}` (path) VALUES('$item')"; my $sth = $PREF{dbh}->prepare($statement); $sth->execute() or die_nice("$0: create_record_for_item_if_DNE('$item') failed: $DBI::errstr\n"); } } sub get_perms_link($$) { my $path_urlencoded = shift; my $dir_urlencoded = shift; my $item = $path_urlencoded . '/' . $dir_urlencoded; slashify($item); my $link = qq`perms`; return logged_in_user_has_permission_to_view_perms($item) ? $link : undef; } sub get_effective_folder_permissions($$) { my $username = shift || ''; my $item = shift || ''; printd "get_effective_folder_permissions('$username', '$item')\n"; # If custom folder permissions aren't enabled, then the effective folder permissions # are RW. This function does not concern itself with groups_allowed_to_*; that is a # question of permitted actions in general, and is handled by user_is_allowed_to() in # the caller. # return 'rw' unless $PREF{enable_custom_folder_permissions} =~ /yes/i; my $userid = get_user_id($username); return 'rw' if is_admin($userid); slashify($item); printd "get_effective_folder_permissions: userid=$userid\n"; # special case for userdirs. note that we check this *after* checking whether # any direct perms are set, so that the admin can still mark any userdir as # ro, for example. # #printd "here...... \$PREF{enable_userdirs}='$PREF{enable_userdirs}', userdir=$PREF{userdir}\nneed: item='/$PREF{userdir_folder_name}/$PREF{userdir}/'\nhave: item='$item'\n"; # if($PREF{enable_userdirs} =~ /yes/i && $PREF{userdir} && $item =~ m!^/$PREF{userdir_folder_name}/$PREF{userdir}(/|$)!) { return 'rw'; } # first check if there are permissions set on this item directly. # if($PREF{user_perms_override_group_perms_for_same_folder} =~ /yes/i) { foreach my $level ('rw', 'ro') { return $level if id_has_direct_access_to_item('user', $level, $userid, $item); } foreach my $level ('rw', 'ro') { return $level if one_of_this_users_groups_has_direct_access_to_item($level, $userid, $item); } } else { foreach my $level ('rw', 'ro') { return $level if one_of_this_users_groups_has_direct_access_to_item($level, $userid, $item); } foreach my $level ('rw', 'ro') { return $level if id_has_direct_access_to_item('user', $level, $userid, $item); } } # if we're still here, then there are no direct permissions set, # so find the closest inherited permissions. # my $closest_user_perms = find_closest_inherited_permissions_for_id('user', $userid, $item); my $closest_group_perms = find_closest_inherited_permissions_for_this_users_groups($userid, $item); my ($user_level, $depth_of_user_level) = ($closest_user_perms =~ /(r[ow])(\d+)/); my ($group_level, $depth_of_group_level) = ($closest_group_perms =~ /(r[ow])(\d+)/); if($closest_user_perms && $closest_group_perms) { return $depth_of_user_level < $depth_of_group_level ? $user_level : $group_level; } elsif($closest_user_perms) { return $user_level; } elsif($closest_group_perms) { return $group_level; } else { return $PREF{default_folder_rights}; } } # slashify($item) before calling. sub one_of_this_users_groups_has_direct_access_to_item($$$) { my ($level, $userid, $item) = @_; get_groups_where_user_is_member($userid); if(my $direct_access_gids = get_groups_with_direct_access_to_item($level, $item)) { foreach my $gid (split(/,/, $direct_access_gids)) { if($PREF{groups_where_user_is_member}{$userid}{gids}{$gid}) { printd "one_of_this_users_groups_has_direct_access_to_item(): returning 1\n"; return 1; } } } } # slashify($item) before calling. sub find_closest_inherited_permissions_for_this_users_groups($$$) { my ($userid, $item) = @_; get_groups_where_user_is_member($userid); my ($closest_depth, $closest_level) = (); foreach my $gid (keys %{$PREF{groups_where_user_is_member}{$userid}{gids}}) { if(my $result = find_closest_inherited_permissions_for_id('group', $gid, $item)) { my ($level,$depth) = ($result =~ /(r[ow])(\d+)/); if($closest_depth !~ /^\d+$/ || $depth < $closest_depth) { $closest_depth = $depth; $closest_level = $level; } } } return $closest_level . $closest_depth; } # accepts a uid or a gid. # slashify($item) before calling. sub find_closest_inherited_permissions_for_id($$$) { my ($type, $id, $item) = @_; my $numlevels = 1; while($item =~ m![^/]!) { remove_deepest_level($item); # since any given level (i.e. the level that $item is at now) can't # have both ro and rw set simultaneously, it doesn't matter what # order these return statements are in. return 'ro' . $numlevels if id_has_direct_access_to_item($type, 'ro', $id, $item); return 'rw' . $numlevels if id_has_direct_access_to_item($type, 'rw', $id, $item); $numlevels++; } return undef; } # accepts a uid or a gid. # slashify($item) before calling. sub id_has_direct_access_to_item($$$$) { my ($type, $level, $id, $item) = @_; # type is user/group, level is ro/rw. if($type eq 'user' && $id =~ /^-/) { # If the ID we received is a userid, and it is negative, then we are # not integrated with UserBase, which means there aren't really any # users, only groups (and only 3 groups at that). So we do the perms # based on groups in this case, thus the answer is "no" here. return 0; } my $id_list = get_ids_with_direct_access_to_item($type, $level, $item); my $retval = $id_list =~ /(^|,)$id(,|$)/ ? 1 : 0; printd "id_has_direct_access_to_item(): returning $retval\n"; return $retval; } # assumes input ends with a slash and returns it that way. sub remove_deepest_level { s!/+$!! for @_; s![^/]+$!! for @_; for(@_) { $_ = '/' unless $_; } } # slashify($item) before calling. sub logged_in_user_has_permission_to_view_perms($) { #printd "logged_in_user_has_permission_to_view_perms('$_[0]')\n"; my $item = shift; if($PREF{admin_is_logged_in}) { return 1; } elsif($PREF{permissions_required_to_view_permissions} =~ /^none$/i) { return 1; } elsif($PREF{permissions_required_to_view_permissions} =~ /^r[wo]$/i) { return 1 if get_effective_folder_permissions($PREF{logged_in_username},$item) =~ /^$PREF{permissions_required_to_view_permissions}$/i; } else { return 0; } } # slashify($item) before calling. sub logged_in_user_has_permission_to_change_perms($) { #printd "logged_in_user_has_permission_to_change_perms('$_[0]')\n"; my $item = shift; if($PREF{admin_is_logged_in}) { return 1; } elsif($PREF{users_can_change_perms_in_own_userdir} =~ /yes/i) { # TODO: should we remove userbase_available() from this check, so this works for serial-userdirs too? # return 1 if ($PREF{enable_userdirs} =~ /yes/i && userbase_available() && $PREF{userdir} && $item =~ m!^/$PREF{userdir_folder_name}/$PREF{userdir}(/|$)!); } else { return 0; } } # returns a list of uids. sub get_users_with_inherited_access_to_item($$) { return unless userbase_available(); # no users, and thus no uids, without userbase. my $type = shift; # rw or ro. my $item = shift; sql_untaint($item); my $users = (); # first remove the deepest folder name to exclude direct-access users. remove_deepest_level($item); # try parents recursively. while($item =~ m![^/]!) { $users .= ',' . enc_sql_select("SELECT `${type}users` FROM `$PREF{perms_table_name}` WHERE `path` = '$item'"); remove_deepest_level($item); } decommaify($users); return $users; } # returns a list of ids. # slashify($item) before calling. sub get_ids_with_direct_access_to_item($$$) { my $type = shift; # user or group. my $level = shift; # rw or ro. my $item = shift; return if ($type eq 'user' && !userbase_available()); # no users, and thus no uids, without userbase. sql_untaint($item); my $ids = enc_sql_select("SELECT `${level}${type}s` FROM `$PREF{perms_table_name}` WHERE `path` = '$item'"); decommaify($ids); return $ids; } # returns a list of uids. # slashify($item) before calling. sub get_users_with_direct_access_to_item($$) { return unless userbase_available(); # no users, and thus no uids, without userbase. my $type = shift; # rw or ro. my $item = shift; sql_untaint($item); my $users = enc_sql_select("SELECT `${type}users` FROM `$PREF{perms_table_name}` WHERE `path` = '$item'"); decommaify($users); return $users; } # returns a list of gids. # slashify($item) before calling. sub get_groups_with_inherited_access_to_item($$) { my $type = shift; # rw or ro. my $item = shift; sql_untaint($item); my $groups = (); # first remove the deepest folder name to exclude direct-access groups. remove_deepest_level($item); # try parents recursively. while($item =~ m![^/]!) { $groups .= ',' . enc_sql_select("SELECT `${type}groups` FROM `$PREF{perms_table_name}` WHERE `path` = '$item'"); remove_deepest_level($item); } decommaify($groups); return $groups; } sub remove_nonnegative_ids { s/(^|,)\d+//g for @_; } # returns a list of gids. # slashify($item) before calling. sub get_groups_with_direct_access_to_item($$) { my $type = shift; # rw or ro. my $item = shift; sql_untaint($item); my $groups = enc_sql_select("SELECT `${type}groups` FROM `$PREF{perms_table_name}` WHERE `path` = '$item'"); decommaify($groups); return $groups; } sub update_custom_folder_perms_for_dir($$) { my ($old_dir_name, $new_dir_name) = @_; slashify($old_dir_name, $new_dir_name); sql_untaint($old_dir_name, $new_dir_name); my $errors = (); my ($id,$path) = (); my $sth = $PREF{dbh}->prepare("SELECT `id`,`path` from `$PREF{perms_table_name}` WHERE `path` LIKE '$old_dir_name%'"); if($sth->execute()) { $sth->bind_columns(\$id,\$path); while($sth->fetchrow_arrayref) { my $newpath = $path; $newpath =~ s!^$old_dir_name!$new_dir_name!; my $sth_inner = $PREF{dbh}->prepare("UPDATE `$PREF{perms_table_name}` SET `path`='$newpath' WHERE `id`=$id"); $sth_inner->execute() or $errors .= qq`update_custom_folder_perms_for_dir() failed: $DBI::errstr\n

\n`; } } else { $errors = qq`update_custom_folder_perms_for_dir() failed: $DBI::errstr\n

\n`; } return $errors; } sub get_groups_where_user_is_member { printd "get_groups_where_user_is_member('$_[0]')\n"; my $userid = shift; return if $PREF{groups_where_user_is_member}{$userid}; # already done for this user. if($PREF{integrate_with_userbase} =~ /yes/i) { my $username = get_user_name($userid); my ($id,$group,%groups) = ('', '', ()); check_id_for_sql_safeness($userid); my $sth = $PREF{dbh}->prepare("SELECT `id`, `group` FROM `$PREF{group_table_name}` WHERE `members` REGEXP '(^|,)$userid(,|\$)'"); $sth->execute() or die_nice("$0: get_groups_where_user_is_member('$userid') failed: $DBI::errstr\n"); $sth->bind_columns(\$id, \$group); while($sth->fetchrow_arrayref) { $PREF{groups_where_user_is_member}{$username}{gids}{$id} = 1; $PREF{groups_where_user_is_member}{$username}{groupnames}{$group} = 1; $PREF{groups_where_user_is_member}{$userid}{gids}{$id} = 1; $PREF{groups_where_user_is_member}{$userid}{groupnames}{$group} = 1; } # Every account automatically belongs to the public group: # my $public_group_id = get_group_id($PREF{public_group_name}); $PREF{groups_where_user_is_member}{$username}{gids}{$public_group_id} = 1; $PREF{groups_where_user_is_member}{$username}{groupnames}{$PREF{public_group_name}} = 1; $PREF{groups_where_user_is_member}{$userid}{gids}{$public_group_id} = 1; $PREF{groups_where_user_is_member}{$userid}{groupnames}{$PREF{public_group_name}} = 1; # Every logged-in account automatically belongs to the member group: # if($PREF{member_is_logged_in}) { my $member_group_id = get_group_id($PREF{member_group_name}); $PREF{groups_where_user_is_member}{$username}{gids}{$member_group_id} = 1; $PREF{groups_where_user_is_member}{$username}{groupnames}{$PREF{member_group_name}} = 1; $PREF{groups_where_user_is_member}{$userid}{gids}{$member_group_id} = 1; $PREF{groups_where_user_is_member}{$userid}{groupnames}{$PREF{member_group_name}} = 1; } } else { # All users are members of the public group (-1): my $public_group_id = get_group_id($PREF{public_group_name}); $PREF{groups_where_user_is_member}{$userid}{gids}{$public_group_id} = 1; $PREF{groups_where_user_is_member}{$userid}{groupnames}{$PREF{public_group_name}} = 1; my $member_group_id = get_group_id($PREF{member_group_name}); if($userid == -2) # member. { $PREF{groups_where_user_is_member}{$userid}{gids}{$member_group_id} = 1; $PREF{groups_where_user_is_member}{$userid}{groupnames}{$PREF{member_group_name}} = 1; } my $admin_group_id = get_group_id($PREF{admin_group_name}); if($userid == -3) # admin. { $PREF{groups_where_user_is_member}{$userid}{gids}{$member_group_id} = 1; $PREF{groups_where_user_is_member}{$userid}{groupnames}{$PREF{member_group_name}} = 1; $PREF{groups_where_user_is_member}{$userid}{gids}{$admin_group_id} = 1; $PREF{groups_where_user_is_member}{$userid}{groupnames}{$PREF{admin_group_name}} = 1; } } } sub ftp_files_to_another_server { my @files_to_send = @_; my @ftp_errors = (); use Net::FTP; my $ftp = Net::FTP->new($PREF{ftp_server}, Debug => 0, Passive => $PREF{use_passive_ftp_mode} =~ /yes/i ? 1 : 0) or push @ftp_errors, "$PREF{internal_appname}: cannot connect to FTP server '$PREF{ftp_server}': $@\n"; return @ftp_errors if @ftp_errors; $ftp->login($PREF{ftp_username},$PREF{ftp_password}) or push @ftp_errors, "$PREF{internal_appname}: FTP: Cannot login: ", $ftp->message; return @ftp_errors if @ftp_errors; #printd "PWD: " . $ftp->pwd() or "$PREF{internal_appname}: FTP: Cannot get working directory ", $ftp->message); # #for($ftp->ls()) #{ # printd "FTP item: $_"; #} foreach my $file_with_localpath (@files_to_send) { my ($localpath, $leafname) = ($file_with_localpath =~ m!(.+)/(.+)!); $leafname = $file_with_localpath unless $leafname; my $file_here = $PREF{uploaded_files_realpath} . '/' . $file_with_localpath; condense_slashes('leave_leading_UNC', $file_here); if($localpath && $PREF{create_subdirs_on_ftp_server} =~ /yes/i) { $localpath = $PREF{base_path_on_ftp_server} . '/' . $localpath; condense_slashes($localpath); printd "about to mkdir($localpath)"; $ftp->mkdir($localpath, 1) or push @ftp_errors, "$PREF{internal_appname}: FTP: Cannot create directory '$localpath': ", $ftp->message; printd "finished mkdir($localpath), message is " . $ftp->message; $ftp->cwd($localpath) or push @ftp_errors, "$PREF{internal_appname}: FTP: Cannot cwd into path '$localpath': ", $ftp->message; printd "cwd()'d to '$localpath' successfully"; } else { $ftp->cwd($PREF{base_path_on_ftp_server}) or push @ftp_errors, "$PREF{internal_appname}: FTP: Cannot cwd into base path '$PREF{base_path_on_ftp_server}': ", $ftp->message; printd "cwd()'d to '$PREF{base_path_on_ftp_server}' successfully"; } my $ascii = 0; foreach my $extension (split(/[\s,]+/, $PREF{extensions_to_use_ascii_mode_for})) { $ascii = 1 if $leafname =~ /$extension$/i; } if($ascii) { printd "enabling ASCII transfer mode"; $ftp->ascii(); } else { printd "enabling BINARY transfer mode"; $ftp->binary(); } printd "about to put($file_here)"; my $put_error = 0; if(!$ftp->put($file_here)) { $put_error = 1; push @ftp_errors, "$PREF{internal_appname}: FTP: Cannot put file '$file_here' onto FTP server: ", $ftp->message; } if($PREF{delete_files_on_this_server_after_successful_ftp} =~ /yes/i && !$put_error) { unlink($file_here) or push @ftp_errors, "$PREF{internal_appname}: FTP: could not delete file '$file_here' after successful FTP transfer: $!"; } } $ftp->quit; return @ftp_errors; } sub extract_archive($$) { my $archive_file = shift; my $output_dir = shift; =item use Archive::Extract; my $ae = Archive::Extract->new( archive => $archive_file ); my $success = 0; if($output_dir) { $success = $ae->extract( to => $output_dir ); } else { # extract to cwd(). $success = $ae->extract; } return ($success, $ae->error); =cut } # EB, FC sub get_human_test_form { my $dir_url = $PREF{human_test_image_directory}; my $dir_real = $PREF{DOCROOT} . '/' . $PREF{human_test_image_directory}; $dir_url .= '/' unless $dir_url =~ m!/$!; $dir_real .= '/' unless $dir_real =~ m!/$!; condense_slashes('leave_leading_UNC', $dir_real); create_dir_if_DNE($dir_real, $PREF{writable_dir_perms_as_octal}); my ($number) = $PREF{human_test_is_invisible} =~ /yes/i ? ($PREF{humantest_code}) : (rand() =~ /(\d{$PREF{human_test_num_digits}})/); die_nice("$PREF{internal_appname}: human_test(): problem creating number; got '$number'.") unless $number =~ /^\d{6}$/; my $hash = md5_hex($number . $PREF{human_test_salt_value}); my $image_leafname = $hash . '.jpg'; my $image_filename = $dir_real . $image_leafname; my ($width,$height) = ($PREF{human_test_image_width},$PREF{human_test_image_height}); my $wave_amplitude = 4; my $final_width = $width; my $final_height = $height; if($PREF{imagemagick_available} =~ /yes/i) { # convert -background white -fill red -size 100x -gravity center -wave 15x100 label:012345 foo.jpg $final_width = $width + $PREF{human_test_border_size} * 2; $final_height = $height + $wave_amplitude * 2 + $PREF{human_test_border_size} * 2; my $image = Image::Magick->new; $image->Set(size=>"${width}x$height"); $image->ReadImage("xc:$PREF{human_test_background_color}"); $image->Annotate(fill=>$PREF{human_test_text_color}, pointsize=>$PREF{human_test_text_size}, gravity=>'center', text=>$number); $image->Wave(amplitude=>$wave_amplitude, wavelength=>$width/2); $image->Border(color=>$PREF{human_test_border_color}, width=>$PREF{human_test_border_size}, height=>$PREF{human_test_border_size}); $image->Set(quality=>85); my $return_value = $image->Write($image_filename); # creates the image file, but still returns undef?? if(! -e $image_filename) { die_nice("$PREF{internal_appname}: human_test(): couldn't write image: $! (return value from \$image->Write() was '$return_value')\n"); } } elsif($PREF{gd_available} =~ /yes/i) { my $img = GD::Simple->new($width,$height); $img->bgcolor($PREF{human_test_background_color}); $img->fgcolor($PREF{human_test_border_color}); $img->setThickness($PREF{human_test_border_size}); $img->rectangle(0,0,$width-1,$height-1) if $PREF{human_test_border_size}; $img->fgcolor($PREF{human_test_text_color}); $img->fontsize($PREF{human_test_text_size}); $img->moveTo(5,15); $img->string($number); open(IMAGEFH, ">$image_filename") or die_nice("$PREF{internal_appname}: couldn't create human test image '$image_filename': $!\n"); my $fh = \*IMAGEFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)". flock $fh, 2; seek $fh, 0, 0; print $fh $img->jpeg(85); close $fh or die_nice("$PREF{internal_appname}: couldn't close image '$image_filename': $!\n"); } else { die "$0: no image-creating library available...\n"; } chmod 0666, $image_filename; my $style = $PREF{human_test_is_invisible} =~ /yes/i ? qq`style="display: none;"` : ''; my $output = qq`` . qq`
$TEXT{Human_test__type_the_numbers_in_the_box_}` . qq`
human test image` . qq`` . qq`
` . qq`
` . qq`\n`; } # EB, FC sub do_human_test { my $original_hash = shift; my $user_input = shift; my $user_hash = md5_hex($user_input . $PREF{human_test_salt_value}); # Also make sure that the image file actually (still) exists, to # protect against replay attacks. # my $dir_real = $PREF{DOCROOT} . '/' . $PREF{human_test_image_directory}; $dir_real .= '/' unless $dir_real =~ m!/$!; condense_slashes('leave_leading_UNC', $dir_real); my $image_leafname = $user_hash . '.jpg'; my $image_filename = $dir_real . $image_leafname; my $passed_test = ($user_hash eq $original_hash && -e $image_filename); return $passed_test; } sub show_all_permissions() { exit_with_error("Access denied: insufficient permissions to access this page.") unless $PREF{admin_is_logged_in}; exit_with_error("This feature is not enabled.") unless custom_folder_perms_enabled(); start_html_output("All permissions", 'css'); print qq`

This page shows all the permissions that have been explicitly set, for all users/groups on all folders.  It does not show any implicit permissions, which means that inherited permissions are not shown, and permissions that users have via their group memberships are not shown.

\n`; my $letter = $qs =~ /(?:^|&)which=([a-z])(?:&|$)/i ? $1 : $qs =~ /(?:^|&)which=all(?:&|$)/i ? 'all' : 'all'; print qq`\n`; print qq`\n`; my $i = 0; my $some_rows_displayed = 0; if(userbase_available()) { foreach my $type ('Group', 'User') { my $colname = $type eq 'User' ? 'username' : 'group'; my $tablename = $PREF{lc($type) . '_table_name'}; my $restriction = ($letter eq 'all' || !userbase_available()) ? undef : " WHERE LOWER(`$colname`) LIKE LOWER('$letter%') "; my ($id,$name) = (); my $sth = $PREF{dbh}->prepare("SELECT `id`,`$colname` FROM `$tablename` ${restriction} ORDER BY `$colname`"); $sth->execute() or die_nice("$PREF{internal_appname}: show_all_permissions(): failed while getting IDs and ${type}s: $DBI::errstr\n"); $sth->bind_columns(\$id,\$name); while($sth->fetchrow_arrayref) { next if $type eq 'Group' && $name =~ /^$PREF{admin_group_name}$/i; my $row_class = oddeven($i); my $display_name = $type eq 'User' ? $name : $name =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i ? "$name" : $name; print qq`\n`; $some_rows_displayed = 0; foreach my $level ('ro', 'rw') { my $path = ''; my $sth2 = $PREF{dbh}->prepare("SELECT `path` FROM `$PREF{perms_table_name}` WHERE `${level}" . lc($type) . "s` REGEXP '(^|,)$id(,|\$)' ORDER BY `path`"); $sth2->execute() or die_nice("$PREF{internal_appname}: show_all_permissions(): failed while getting paths from perms table for id=$id: $DBI::errstr\n"); $sth2->bind_columns(\$path); while($sth2->fetchrow_arrayref) { print qq`\n`; $some_rows_displayed = 1; } } print qq`\n` unless $some_rows_displayed; } } } else { my %groupname = (-1 => $PREF{public_group_name}, -2 => $PREF{member_group_name}); foreach my $id (-2, -1) { my $row_class = oddeven($i); print qq`\n`; $some_rows_displayed = 0; foreach my $level ('ro', 'rw') { my $path = ''; my $sth2 = $PREF{dbh}->prepare("SELECT `path` FROM `$PREF{perms_table_name}` WHERE `${level}groups` REGEXP '(^|,)$id(,|\$)' ORDER BY `path`"); $sth2->execute() or die_nice("$PREF{internal_appname}: show_all_permissions(): failed while getting paths from perms table for id=$id: $DBI::errstr\n"); $sth2->bind_columns(\$path); while($sth2->fetchrow_arrayref) { print qq`\n`; $some_rows_displayed = 1; } } print qq`\n` unless $some_rows_displayed; } } print qq`\n
NameFolderAccess
Level
$type $display_name
$path` . uc($level) . qq`
(none)
Group $groupname{$id}
$path` . uc($level) . qq`
(none)
\n`; if(userbase_available()) { print qq`

\nFilter list:

All`; foreach my $char ('A'..'Z') { print qq`$char`; } print qq`\n

`; } finish_html_output('home', 'uploader', 'list'); } ############################################################################################################################################ ### Functions: general. ############################################################################################################################################ sub get_cookies() { use CGI ':standard'; use CGI::Cookie; my %cookies = fetch CGI::Cookie; return %cookies; } sub get_cookie($) { my $which = shift; my %jar = get_cookies(); my $value = ''; if(exists $jar{$which}) { $value = $jar{$which}->value; } elsif($which eq $PREF{site_session_cookie}) { if($qs =~ /(?:^|&)ubsessioncode=(\w+)(?:&|$)/) { my $code = $1; # Accepting the session code from the URL should only be allowed as a last resort. # On decent servers this shouldn't be necessary because we can call UserBase # from PHP using virtual() and/or exec() both of which pass the cookies. Even # on sub-par servers where we have to use include() with the full http:// URL, # we can reduce the security risk by requiring the remote IP to match the server # IP, i.e. ONLY allow the include(http://...) method to work: don't accept URL- # based session codes from any other IP. As a last resort on totally sucky # servers where PHP is crippled and $ENV{SERVER_ADDR} DNE or is variable or # otherwise useless, proceed only by setting a PREF that indicates what a bad # idea it is. if($ENV{REMOTE_ADDR} eq $ENV{SERVER_ADDR}) { $value = $code; } elsif($PREF{my_server_sucks_so_use_less_secure_mode} =~ /yes/i) { sleep $PREF{sleeptime_for_less_secure_mode} || 3; $value = $code; } } } return $value; } sub set_cookie($$$) { my $name = shift; my $value = shift; my $expiry = shift; my $cookie; # This if/else is necessary because setting "expires" to "" isn't # the same as not setting it. Setting it to "" is the same as # setting it to zero, which expires the cookie immediately # (i.e., deletes it). But explicitly *not* setting the expiry # causes the cookie to persist until the end of the session. if($expiry eq "") { $cookie = new CGI::Cookie( -name => $name, -value => $value, -path => '/'); } else { $cookie = new CGI::Cookie( -name => $name, -value => $value, -expires => $expiry, -path => '/'); } if($PREF{output_started}) { print "

$PREF{internal_appname} warning: cannot set cookie '$name' => '$value' because the page output has already been started (perhaps debug is enabled?).

\n"; } elsif($PREF{we_are_virtual}) { print_http_headers(); print "

$PREF{internal_appname} warning: cannot set cookie '$name' => '$value' because we are virtual.

\n"; } else { print "Set-Cookie: $cookie\n"; } } sub expand_custom_vars_in_prefs($) { my $hashref = shift; foreach my $key (keys %$hashref) { # from now on, use %%varname%% instead of $$varname$$, so that it doesn't # matter whether it gets put in double-quotes. next unless $$hashref{$key} && $$hashref{$key} =~ /(\$\$|%%)/; # old way: $$hashref{$key} =~ s/\$\$server_name\$\$/$ENV{'SERVER_NAME'}/g; $$hashref{$key} =~ s/\$\$httphost_withport\$\$/$ENV{'HTTP_HOST'}/g; $$hashref{$key} =~ s/\$\$name_of_site\$\$/$$hashref{'name_of_site'}/g; # new way: $$hashref{$key} =~ s/%%server_name%%/$ENV{SERVER_NAME}/g; $$hashref{$key} =~ s/%%http_host%%/$ENV{HTTP_HOST}/g; $$hashref{$key} =~ s/%%name_of_site%%/$$hashref{name_of_site}/g; } } # pass filename to create and optionally the mode to chmod it to. # the mode must consist of 1-4 octal digits and must NOT be quoted. # see "perldoc -f chmod" and "man chmod". sub create_file_if_DNE { my $file = shift; my $mode = shift; return if -T $file; open(NEW,">$file") or die "$0: couldn't create new file $file: $!\n"; close NEW or die "$0: couldn't close $file after creating it: $!\n"; if($mode) { chmod($mode,$file) or die "$0: couldn't chmod file \"$file\" with mode \"$mode\": $!\n"; } } sub create_dir_if_DNE { my $dir = shift; my $mode = shift; my $make_parents_if_necessary = shift; $make_parents_if_necessary = $make_parents_if_necessary eq 'make_parents' ? 1 : 0; return if -d $dir; $dir =~ s!\\!/!g; if($make_parents_if_necessary) { my $progressively_longer_path = ''; my $ms_windows = 0; if($dir =~ m!^(\w:)/!) { $progressively_longer_path = $1; $ms_windows = 1; } my $i = 0; foreach my $individual_path_element(split(/\//, $dir)) { $i++; next if $i == 1 && $ms_windows; $progressively_longer_path .= '/' . $individual_path_element; unless(-d $progressively_longer_path) { mkdir($progressively_longer_path,$PREF{writable_dir_perms_as_octal}) or die_nice("$PREF{internal_appname}: create_dir_if_DNE(): couldn't create path-portion '$progressively_longer_path' as part of dir '$dir': $!"); if($mode) { chmod($mode,$progressively_longer_path) or die_nice("$PREF{internal_appname}: create_dir_if_DNE(): couldn't chmod path-portion '$progressively_longer_path' as part of dir '$dir' with mode '$mode': $!"); } } } } else { mkdir($dir,$PREF{writable_dir_perms_as_octal}) or die_nice("$PREF{internal_appname}: create_dir_if_DNE(): couldn't create dir $dir: $!"); if($mode) { chmod($mode,$dir) or die_nice("$PREF{internal_appname}: create_dir_if_DNE(): couldn't chmod dir \"$dir\" with mode \"$mode\": $!"); } } } sub send_email { my ($to, $from, $subj, $msg, $mimetype, $die_on_error, $attachment_hashref) = @_; $mimetype = 'text/plain' unless $mimetype; $die_on_error = $die_on_error eq 'die_on_email_error' ? 1 : 0; my $do_fork = !$die_on_error; # if we want to die on error, we can't fork, or the die() will go unreported. $do_fork = 0 if $^O =~ /MSWin32/; # Windows' fork-fu is weak. my ($mail_sent_successfully, $error_msg) = 0; # fork here because sending mail can be slow (and can block) sometimes. # Note: if we don't set $do_fork, perl won't even evaluate the &&'s second # half, so the fork won't happen, and the else{} will. my $forkpid = (); if($do_fork && ($forkpid = fork)) { # parent } else { # child use POSIX; if($do_fork) { defined $forkpid or die "$PREF{internal_appname}: fork error in send_email(): $@\n"; POSIX::setsid() unless $^O =~ /MSWin32/; close STDOUT; close STDIN; } my $msgid = '<' . time . '.' . md5_hex($to . $from . $subj . $msg . $$ . $ENV{REMOTE_PORT}) . '@' . $ENV{HTTP_HOST} . '>'; if($PREF{smtp_server} =~ /\w/) { # Wrap this in an eval{} in case MIME::Lite is missing. # Then we can have the option of setting $PREF{'disable_all_email'} # so that the site still functions, sans email. eval { require MIME::Lite; my $type = (); if($mimetype) { $type = $mimetype; } else { #my $type = $attachment_hashref ? 'multipart/mixed' : 'text/plain'; $type = $attachment_hashref ? 'multipart/mixed' : 'text/plain; charset=ISO-8859-1; format=flowed'; } my $mime_msg = MIME::Lite->new(To => $to, From => $from, Subject => $subj, Type => $type, Data => $msg); unless($mime_msg) { if($die_on_error) { die "$PREF{internal_appname}: error creating MIME body: $!\n"; } else { warn "$PREF{internal_appname}: error creating MIME body: $!\n"; } } if($PREF{generate_message_id_internally} =~ /yes/i) { $mime_msg->add('Message-ID' => $msgid); } if($attachment_hashref) { foreach my $key (keys %$attachment_hashref) { my $mimetype = $$attachment_hashref{$key}{mimetype}; # like 'application/x-gzip' my $filename = $$attachment_hashref{$key}{filename}; my $recommended_filename = $$attachment_hashref{$key}{recommended_filename}; $recommended_filename =~ s!^.*(\\|/)!!; # strip off any preceeding path # Attach the test file $mime_msg->attach( Type => $mimetype, Path => $filename, Filename => $recommended_filename, Disposition => 'attachment' ) or my $foo = sub { if($die_on_error) { die "$PREF{internal_appname}: error attaching file to email: $!\n"; } else { warn "$PREF{internal_appname}: error attaching file to email: $!\n"; } }; } } $PREF{smtp_server} = enc_untaint($PREF{smtp_server}); if($PREF{smtp_auth_username} =~ /\S/ && $PREF{smtp_auth_password} =~ /\S/) { eval { MIME::Lite->send('smtp', $PREF{smtp_server}, Timeout=>30, AuthUser=>$PREF{smtp_auth_username}, AuthPass=>$PREF{smtp_auth_password}, Port=>$PREF{smtp_port}); }; } else { eval { MIME::Lite->send('smtp', $PREF{smtp_server}, Timeout=>30, Port=>$PREF{smtp_port}); }; } if($@) { if($die_on_error) { die "$PREF{internal_appname}: MIME::Lite->send failed: $@\n"; } else { warn "$PREF{internal_appname}: MIME::Lite->send failed: $@\n"; } } eval { $mime_msg->send; }; if($@) { if($die_on_error) { die "$PREF{internal_appname}: \$mime_msg->send failed: $@\n"; } else { warn "$PREF{internal_appname}: \$mime_msg->send failed: $@\n"; } } else { $mail_sent_successfully = 1; } if($attachment_hashref) { foreach my $key (keys %$attachment_hashref) { unlink( $$attachment_hashref{$key}{filename} ) if $$attachment_hashref{$key}{'delete-after-sending'} eq 'yes'; } } }; } my $smtp_error = $@ if $@; if(-e $PREF{path_to_sendmail} && !$mail_sent_successfully) { if($smtp_error) { warn "$PREF{internal_appname}: send_email(): SMTP failed, so falling back to sendmail. SMTP error was: $smtp_error\n"; } eval { $PREF{path_to_sendmail} = enc_untaint($PREF{path_to_sendmail}, 'keep_path'); open(SENDMAIL, "|$PREF{path_to_sendmail} -oi -t") or die_nice "$PREF{internal_appname}: Can't fork for sendmail: $!\n"; if($attachment_hashref) { print SENDMAIL qq`MIME-Version: 1.0` . qq`\nFrom: $from` . qq`\nTo: $to` . qq`\nSubject: $subj` . ($PREF{generate_message_id_internally} =~ /yes/i ? "\nMessage-Id: $msgid" : '') . qq`\nContent-Type: multipart/mixed; boundary=encindboundarystring` . qq`\n` . qq`\n--encindboundarystring` . qq`\nContent-Type: ` . ($mimetype ? $mimetype : 'text/plain') . qq`\n` . qq`\n$msg`; foreach my $key (keys %$attachment_hashref) { my $mimetype = $$attachment_hashref{$key}{mimetype}; # like 'application/x-gzip' $mimetype = 'application/octet-stream' unless $mimetype; my $filename = $$attachment_hashref{$key}{filename}; my $recommended_filename = $$attachment_hashref{$key}{recommended_filename}; $recommended_filename =~ s!^.*(\\|/)!!; # strip off any preceeding path my $atch = `uuencode $filename $filename`; # UUencode it so we can send it as an attachment print SENDMAIL qq`\n____________________` . qq`\nAttachment: $filename:` . qq`\n` . qq`\n--encindboundarystring` . qq`\nContent-Type: $mimetype; name="$filename"` . qq`\nContent-Transfer-Encoding: x-uuencode` . qq`\nContent-Disposition: attachment; filename="$recommended_filename"` . qq`\n` . qq`\n$atch` . qq`\n` . qq`\n--encindboundarystring`; } print SENDMAIL qq`\n--encindboundarystring--\n` } else # no attachment. { print SENDMAIL qq`From: $from` . qq`\nTo: $to` . qq`\nSubject: $subj` . ($PREF{generate_message_id_internally} =~ /yes/i ? "\nMessage-Id: $msgid" : '') . qq`\nContent-Type: $mimetype` . qq`\n` . qq`\n$msg`; } close(SENDMAIL) or die_nice "$PREF{internal_appname}: sendmail didn't close nicely: $!\n"; }; if(!$@) { $mail_sent_successfully = 1; } } my $sendmail_error = $@ if $@; unless($mail_sent_successfully) { if($smtp_error) { $error_msg = "$PREF{internal_appname}: couldn't send email: error in send_email() while trying to use MIME::Lite with SMTP server '$PREF{smtp_server}'. Error was: '$smtp_error'\n"; } elsif($sendmail_error) { $error_msg = "$PREF{internal_appname}: couldn't send email: error in send_email() while trying to use sendmail with path '$PREF{path_to_sendmail}'. Error was: '$sendmail_error'\n"; } else { $error_msg = "$PREF{internal_appname}: couldn't send email: error in send_email(): perhaps you need to adjust \$PREF{smtp_server} (currently '$PREF{smtp_server}') or \$PREF{path_to_sendmail} (currently '$PREF{path_to_sendmail}').\n"; } if($die_on_error) { die $error_msg; } else { warn $error_msg; } } if($do_fork) { exit; # exit the child process. } } return ($mail_sent_successfully, $error_msg); } sub enc_untaint { my $item = shift || ''; my $original_item = $item; my $keep_path = shift || ''; #printd "enc_untaint($item)\n"; # Regardless of whether we're keeping the path, dots surrounded by slashes are never allowed. # #$item =~ s!(^|/|\\)\.+(/|\\|$)!$1!g; $item =~ s!\\!/!g; # Need to remove MS garbage beforehand, otherwise an input like .\\StupidCGI.tmp will break this. while($item =~ m!((?:^|/|\\)\.+(?:/|\\|$))!) { $item =~ s!$1!/!; } #printd "removed slashdots: $item\n"; if( $item =~ m!(/|\\)! && !$keep_path) { $item =~ s!^.*[/\\]+([^/\\]+)!$1!; # remove any path from the front. #printd "removed path from front: $item\n"; $item =~ s!^([^/\\]+)[/\\]+!$1!; # ...and the back. } $item =~ s![`\*\?\|<>]!!g; # remove some other potentially-unsafe stuff. my $leading_UNC_slashes = ''; if($item =~ m!^//! && $keep_path) { $leading_UNC_slashes = '//'; $item =~ s!^/+!!; } $item =~ s![/\\]{2,}!/!g; # condense any multiples. $item = $leading_UNC_slashes . $item; # add back any UNC slashes. ($item) = ($item =~ /(.*)/); # untaint. # In case anything slips through, die as a security precaution. # die qq`$0: couldn't untaint "$original_item".\n` if $item =~ m![/\\]! && !$keep_path; die qq`$0: couldn't untaint "$original_item".\n` if $item =~ m!(?:^|/|\\)\.+(?:/|\\|$)!; die qq`$0: couldn't untaint "$original_item".\n` if $item =~ m!^\.+$!; die qq`$0: couldn't untaint "$original_item".\n` if $item =~ m!^\s*$!; #printd "untainted: $item\n\n"; return $item; } sub enc_urlencode { for(@_) { s/([^\w()'*~!.-])/sprintf '%%%02x', ord $1/eg if $_; }; } sub enc_urldecode { # assuming the input really was URL-encoded, then any plus-signs that were originally there # are now in their hex form, so any plus-signs STILL there were converted from spaces by the # browser. so they must be converted back BEFORE restoring any original plus-signs from the # hex codes. convert_plus_signs_back_to_spaces_in_var_from_GET_method(@_); for(@_) { s/%([a-fA-F\d]{2})/chr hex $1/eg if $_; } } sub convert_plus_signs_back_to_spaces_in_var_from_GET_method { for(@_) { s/\+/ /g if $_; } } sub enc_redirect { my $destination = shift; if($destination =~ /^referr?er$/i) { $destination = $ENV{HTTP_REFERER} ? $ENV{HTTP_REFERER} : $PREF{redirection_backup_address}; } unless($destination =~ m!^https?://!) { $destination = $PREF{protoprefix} . $ENV{HTTP_HOST} . $destination; } if($PREF{output_started}) { print qq`

$PREF{internal_appname} warning: cannot redirect because output has already started (perhaps debug is enabled?).  Click here to continue.

\n`; } elsif($PREF{we_are_virtual}) { warn "$0: enc_redirect(): cannot redirect because we are virtual.\n"; print_http_headers(); print qq`

$PREF{internal_appname} warning: cannot redirect because we are virtual.  Click here to continue.

\n`; } else { if($ENV{SERVER_SOFTWARE} =~ /microsoft-iis/i) { # A bug in IIS v5 (and lower, probably) makes cookie-setting fail # when combined with a header-based redirect: # # "BUG: Set-Cookie Is Ignored in CGI When Combined With Location" # http://support.microsoft.com/kb/q176113/ # # So use a meta-redirect instead. # print "Content-type: text/html\n\n"; print qq`\n`; } else { print "Location: $destination\n\n"; } } exit; } # FC, UB, VL sub condense_slashes { s!\\!/!g; my $leave_leading_UNC = 0; for(@_) { if(/^leave_leading_UNC$/) { $leave_leading_UNC = 1; next; } if($leave_leading_UNC) { my $leading_UNC_slashes = ''; if(m!^//!) { $leading_UNC_slashes = '//'; s!^/+!!; } s!/{2,}!/!g; # condense any multiples. $_ = $leading_UNC_slashes . $_; # add back any UNC slashes. } else { s!/{2,}!/!g; } } } # FC, UB, VL sub slashify { # add leading and trailing slashes and condense duplicates. $_ = '/' . $_ . '/' for @_; s!/{2,}!/!g for @_; } # FC, UB, VL sub deslashify { # remove leading and trailing slashes and condense duplicates. s!/{2,}!/!g for @_; s!^/!!g for @_; s!/$!!g for @_; } # FC, UB, VL sub commaify { # add leading and trailing commas and condense duplicates. $_ = ',' . $_ . ',' for @_; s!,{2,}!,!g for @_; } # FC, UB, VL sub decommaify { # remove leading and trailing commas and condense duplicates. s!,{2,}!,!g for @_; s!^,!!g for @_; s!,$!!g for @_; } # FC, UB, VL sub die_unless_numeric($$) { my $number = shift; my $varname = shift; die_nice("$0: non-numeric $varname '$number'...\n") unless $number =~ /^\d+$/; } # FC, UB, VL sub print_http_headers { unless($PREF{output_started} || $PREF{xml_output_started}) { print "Cache-Control: no-store, no-cache\n"; print "Content-type: text/html\n\n"; $PREF{output_started} = 1; } } # FC, UB, VL sub offsettime { return time + $PREF{time_offset}; } # FC, UB, VL sub sql_untaint { s/"/"/g for @_; s/'/'/g for @_; s/`/`/g for @_; s/\\/\/g for @_; } # FC, UB, VL sub sql_un_untaint { s/"/"/g for @_; s/'/'/g for @_; s/`/`/g for @_; s/\/\\/g for @_; } # FC, UB, VL sub enc_hash { return $PREF{use_md5_for_hashes} =~ /yes/i ? md5_hex(@_) : sha1_hex(@_); } # FC, UB, VL sub not_sqlsafe { #print STDERR "not_sqlsafe: got: $_[0]\n"; # Escape any dashes or closing brackets, as per perlre: # # If you want either "-" or "]" itself to be a member of a class, # put it at the start of the list (possibly after a "^"), or escape # it with a backslash. # my $list_of_sql_safe_characters = $PREF{list_of_sql_safe_characters}; $list_of_sql_safe_characters =~ s/\]/\\]/g; $list_of_sql_safe_characters =~ s/-/\\-/g; return $_[0] =~ /[^$list_of_sql_safe_characters]/; } # FC, UB, VL sub oddeven { $_[0] = 0 unless $_[0] && $_[0] =~ /^\d+$/; $_[0]++; return $_[1] && $_[1] eq 'reset' ? 'odd' : $_[0] % 2 == 0 ? 'even' : 'odd'; } # FC, UB, VL sub enc_sql_select($) { my $statement = shift; my $sth = $PREF{dbh}->prepare($statement); $sth->execute() or die_nice("$PREF{internal_appname}: error while executing SQL select statement [[$statement]]: $DBI::errstr\n"); return $sth->fetchrow; } # FC, UB, VL sub enc_sql_update($) { my $statement = shift; my $sth = $PREF{dbh}->prepare($statement); my $numrows = $sth->execute() or die_nice("$PREF{internal_appname}: error while executing SQL update statement [[$statement]]: $DBI::errstr\n"); return $numrows; } sub enc_sys_call { # TODO: this doesn't always work. my $cmd = shift; my ($msg,$success) = (); system($cmd); if ($? == -1) { $success = 0; $msg = "error: failed to execute: $!"; } elsif ($? & 127) { $success = 0; $msg = sprintf "error: child died with signal %d, %s coredump", ($? & 127), ($? & 128) ? 'with' : 'without'; } else { $success = 1; $msg = sprintf "child exited with value %d", $? >> 8; } $msg = "enc_sys_call(): command was [[ $cmd ]]; result was [[ $msg ]];"; printd "$msg\n"; return ($success, $msg); } # Success messages that the end-user is supposed to see. # sub exit_with_success { start_html_output('', 'css', 'js'); my $message = join '', @_; $PREF{success_message_template} =~ s/%%message%%/$message/g; print $PREF{success_message_template}; finish_html_output('home'); exit; } # Non-error messages that the end-user is supposed to see. # sub exit_with_notice { start_html_output('', 'css', 'js'); my $message = join '', @_; $PREF{notice_message_template} =~ s/%%message%%/$message/g; print $PREF{notice_message_template}; finish_html_output('home','uploader','list'); exit; } # FC*, PH, UB*, VL # Errors that the end-user is supposed to see. # sub exit_with_error { start_html_output('', 'css', 'js'); my $message = join '', @_; $PREF{error_message_template} =~ s/%%message%%/$message/g; print $PREF{error_message_template} =~ /$message/ ? $PREF{error_message_template} : $message; # in case prefs haven't been loaded yet. finish_html_output('home','uploader','list'); exit; } sub printd { my $msg = shift; chomp $msg; if($PREF{debug} || $PREF{force_debug} =~ /yes/i) { warn "$PREF{internal_appname}-debug: " . (offsettime()) . ": $msg\n"; print $debuglog "$PREF{internal_appname}-debug: " . (offsettime()) . ": $msg\n" if $debuglog; } if($PREF{debug}) { print_http_headers(); print "\n"; } } # Some SQL implementations support other nonsense in the table names; we'll restrict to a sensible set of characters. # sub tablename_is_valid { return ($_[0] =~ /^\w+$/ && length($_[0]) < $PREF{max_tablename_length}); } # FC, UB, VL sub check_tablename_for_sql_safeness { die_nice("Invalid tablename: '$_[0]'") unless tablename_is_valid($_[0]); } # FC, UB, VL sub db_column_exists($$) { my $column_to_find = shift; my $table_name = shift; check_tablename_for_sql_safeness($table_name); my $column_name = (); my $temp = (); my $sth = $PREF{dbh}->prepare("SHOW COLUMNS FROM `$table_name`;"); $sth->execute() or die "$0: Error: db_column_exists(): $DBI::errstr\n"; $sth->bind_columns(\$column_name, \$temp, \$temp, \$temp, \$temp, \$temp); while($sth->fetchrow_arrayref) { return 1 if $column_name eq $column_to_find;; } return 0; } sub get_ip_and_host { my $ip = $ENV{REMOTE_ADDR}; my $host = $ENV{REMOTE_HOST}; if(!($host)) { $host = $ip; } if($host eq $ip) { use Socket; $host = gethostbyaddr(inet_aton($ip), AF_INET); } if(!($host)) { $host = $ip; } return ($ip, $host); } ############################################################################################################################################ ### Functions: login. ############################################################################################################################################ # FC, UB*, VL sub do_login { my $target = shift; if($ENV{REQUEST_METHOD} =~ /post/i) { use CGI ':param'; if(param('password') !~ /\S/) # don't allow blank passwords. { start_html_output('Error', 'css'); print qq`
You must enter the password.
`; finish_html_output('home'); exit; } my $hashed_password = md5_hex(param('password')); my $expiry = (); if(param('persist') eq 'on') { $expiry = "+$PREF{num_days_login_lasts}d"; } if($hashed_password eq $PREF{admin_password_hash} || $hashed_password eq $PREF{member_password_hash}) { set_cookie($PREF{non_userbase_login_cookie}, $hashed_password, $expiry); if($target eq 'list_files') { enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_filelist}?action=listfiles"); } else # default to the front page (the upload page). { enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_uploader}"); } } else { start_html_output($TEXT{Invalid_Login}, 'css'); print qq`
$TEXT{The_password_you_entered_is_incorrect___}
` . qq`\n`; finish_html_output('home'); } } else { my $scripttarget = $target ? "action=login&target=$target" : 'login'; start_html_output($TEXT{Enter_the_password}, 'css'); print qq`
` . qq`\n

$TEXT{Enter_the_password}

` . qq`\n` . qq`\n

$TEXT{Keep_me_logged_in_for} $PREF{num_days_login_lasts} $TEXT{days}` . qq`\n

` . qq`\n
` . qq`\n`; finish_html_output('home'); } } # FC, UB*, VL sub check_if_logged_in() { my %cookies = get_cookies(); ($PREF{admin_is_logged_in}, $PREF{member_is_logged_in}, $PREF{logged_in_username}, $PREF{logged_in_realname}, $PREF{logged_in_email}, $PREF{logged_in_userid}) = (0,0,'','','',''); if($PREF{integrate_with_existing_login_system} =~ /yes/i && $PREF{integrate_with_userbase} !~ /yes/i) { if($PREF{enable_username_from_cookie} =~ /yes/i) { my $username_in_cookie = (); if(exists($cookies{$PREF{admin_username_cookie_name}}) && ($username_in_cookie = $cookies{$PREF{admin_username_cookie_name}}->value)) { ($PREF{admin_is_logged_in}, $PREF{member_is_logged_in}, $PREF{logged_in_username}, $PREF{logged_in_userid}) = (1, 1, $username_in_cookie, -3); } elsif(exists($cookies{$PREF{member_username_cookie_name}}) && ($username_in_cookie = $cookies{$PREF{member_username_cookie_name}}->value)) { ($PREF{admin_is_logged_in}, $PREF{member_is_logged_in}, $PREF{logged_in_username}, $PREF{logged_in_userid}) = (0, 1, $username_in_cookie, -2); } } elsif($PREF{enable_username_from_php_session} =~ /yes/i) { my $username = ''; my $isadmin = 0; if($ENV{PHP_ENC_USERNAME}) { $username = $ENV{PHP_ENC_USERNAME}; save_php_var_to_cache('username',$username); $isadmin = $ENV{PHP_ENC_ISADMIN}; save_php_var_to_cache('isadmin',$isadmin); } else # we were POSTed to? { $username = get_php_var_from_cache('username'); $isadmin = get_php_var_from_cache('isadmin'); } if($username) { $PREF{logged_in_username} = $username; $PREF{member_is_logged_in} = 1; $PREF{admin_is_logged_in} = $isadmin; $PREF{logged_in_userid} = $PREF{admin_is_logged_in} ? -3 : -2; } } } elsif($PREF{integrate_with_userbase} =~ /yes/i) { if(my $session_id = get_cookie($PREF{site_session_cookie})) { check_sessionid_for_sql_safeness($session_id); my ($username,$realname,$email,$id,$ip) = enc_sql_select("SELECT username,name,email,id,ip FROM `$PREF{user_table_name}` WHERE `mrsession` = '$session_id';"); if($username && $id) { if(($PREF{enable_ip_address_restriction} =~ /yes/i && $ip) || ($PREF{force_ip_address_restriction} =~ /yes/i)) { return unless $ip eq $ENV{REMOTE_ADDR}; } if(enc_sql_select("SELECT `acct_disabled` FROM `$PREF{user_table_name}` WHERE `id` = '$id';")) { enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}?phase=eacctdis"); } $PREF{logged_in_username} = $username; $PREF{logged_in_realname} = $realname; $PREF{logged_in_email} = $email; $PREF{logged_in_email} = $PREF{logged_in_username} if ($PREF{logged_in_email} !~ /.+\@.+\..+/ && $PREF{logged_in_username} =~ /.+\@.+\..+/); $PREF{logged_in_userid} = $id; $PREF{member_is_logged_in} = 1; if(is_admin($PREF{logged_in_userid})) { $PREF{admin_is_logged_in} = 1; } check_and_update_login_session($PREF{logged_in_userid}); if(force_pw_change($PREF{logged_in_userid})) { my $go = $PREF{protoprefix} . $ENV{HTTP_HOST} . $PREF{login_url} . "?action=edituser&id=$PREF{logged_in_userid}"; enc_redirect($go); } } } } elsif($PREF{admin_password_hash} || $PREF{member_password_hash}) { my $hashed_password_in_cookie = get_cookie($PREF{non_userbase_login_cookie}); if($hashed_password_in_cookie && ($hashed_password_in_cookie eq $PREF{admin_password_hash})) { ($PREF{admin_is_logged_in}, $PREF{member_is_logged_in}, $PREF{logged_in_username}, $PREF{logged_in_userid}) = (1, 1, undef, -3); } elsif($hashed_password_in_cookie && ($hashed_password_in_cookie eq $PREF{member_password_hash})) { ($PREF{admin_is_logged_in}, $PREF{member_is_logged_in}, $PREF{logged_in_username}, $PREF{logged_in_userid}) = (0, 1, undef, -2); } } } # FC, UB, VL sub check_and_update_login_session($) { my $userid = shift; if($PREF{idle_timeout} > 0) { my $my_session_id = get_cookie($PREF{site_session_cookie}); my $session_id_in_db = enc_sql_select("SELECT `mrsession` FROM `$PREF{user_table_name}` WHERE `id` = $userid;"); my $login_time = enc_sql_select("SELECT `loggedin` FROM `$PREF{user_table_name}` WHERE `id` = $userid;"); #if( ($my_session_id == $session_id_in_db) && ($login_time =~ /[1-9]/ && !login_session_expired($login_time)) ) if( ($my_session_id == $session_id_in_db) && (!login_session_expired($login_time)) ) { update_loggedin_time($userid, $my_session_id, offsettime()); } else { do_logout(); } } } # FC, UB, VL sub update_loggedin_time { my ($userid, $my_session_id, $newtime) = @_; die_unless_numeric($userid,'userid'); die_unless_numeric($newtime,'newtime'); check_sessionid_for_sql_safeness($my_session_id); my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `loggedin` = $newtime WHERE `id` = $userid AND `mrsession` = '$my_session_id';"); die_nice("Error: update_loggedin_time('$userid', '$my_session_id', '$newtime'): SQL returned '$success' instead of '1' while updating loggedin.") unless $success == 1; } # FC, UB, VL sub login_session_expired($) { my $loggedin_time = shift; return ($PREF{idle_timeout} > 0) && (offsettime() - $loggedin_time > $PREF{idle_timeout}); } # FC, UB*, VL sub do_logout() { my $go = (); if($PREF{integrate_with_userbase} =~ /yes/i || $PREF{integrate_with_existing_login_system} =~ /yes/i) { $go = $PREF{logout_url}; } else { set_cookie($PREF{non_userbase_login_cookie}, 'blank', '-1d'); # Remove the "logout" from the referrer, otherwise we'll get stuck # in an infinite logout loop with this Location: call. $ENV{HTTP_REFERER} =~ s/\?logout$//; $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{here_login}?action=loggedout&whence=$ENV{HTTP_REFERER}"; } if($PREF{we_are_virtual}) { print_http_headers(); print qq`

$TEXT{Logging_out_} $TEXT{click_here} $TEXT{to_continue_}

\n`; exit; } else { enc_redirect($go); } } # FC*, UB*, VL* sub show_loggedout_page { my $ref = shift; enc_urldecode($ref); start_html_output('Logged Out', 'css', 'js'); print qq`

Logged Out

\n

You are logged out.

\n`; print qq`

Click here to return to the page you came from.

\n` if $ref; finish_html_output('home','uploader','list'); } # FC, UB, VL # This function must do a case-sensitive lookup (i.e., do NOT use LOWER()) because # FC's userdirs are case-sensitive. So whatever case is used when a username is # created is the case that must always be used when logging in with it. # sub account_exists($$$) { #printd "account_exists('$_[0]', '$_[1]', '$_[2]')\n"; my $user = shift; my $pass = shift; my $third_arg = shift; check_username_for_sql_safeness($user); check_hashedpw_for_sql_safeness($pass); my $count = (); if($third_arg eq 'new_login') { $count = enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE `username` = '$user' AND `password` = '$pass'"); } else { die_unless_numeric($third_arg,'userid'); $count = enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE `username` = '$user' AND `password` = '$pass' AND `id` = $third_arg"); } if($count == 1) { return 1; } elsif($count > 1) { die_nice("$0: account_exists('$user', '$pass', '$third_arg'): error: duplicate records ($count total) for this user!\n"); } else { return 0; } } # FC, UB, VL sub is_admin($) { printd "is_admin('$_[0]')\n"; my $userid = shift; return 0 unless $userid; return 1 if (!userbase_available() && $userid == -3); # don't bother checking the validity of $userid here, # because user_is_member_of_group() will do it. return user_is_member_of_group($userid,$PREF{admin_group_name}); } # FC, UB, VL sub force_pw_change($) { my $userid = shift; return ( $PREF{enable_forced_password_change} =~ /yes/i && enc_sql_select("SELECT `forcepwchng` FROM `$PREF{user_table_name}` WHERE `id` = '$userid';") && ( !is_admin($userid) || (is_admin($userid) && $PREF{admins_can_be_forced_to_change_their_own_pws} =~ /yes/i) ) ); } # FC, UB, VL sub get_group_id($) { printd "get_group_id($_[0])\n"; my $group = shift; if(userbase_available()) { check_groupname_for_uniqueness($group); # checks for sql safeness too. return enc_sql_select("SELECT `id` FROM `$PREF{group_table_name}` WHERE `group` = '$group'"); } else { if($group =~ /^$PREF{public_group_name}$/i) { return -1; } elsif($group =~ /^$PREF{member_group_name}$/i) { return -2; } elsif($group =~ /^$PREF{admin_group_name}$/i) { return -3; } else { die_nice("$PREF{internal_appname}: get_group_id(): invalid group name '$group'.\n"); } } } # FC, UB, VL sub check_uid_for_uniqueness($) { check_id_for_sql_safeness($_[0]); if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE `id` = $_[0]") > 1) { die_nice("$0: error: more than one user record with id=$_[0]!\n"); } } # FC, UB, VL sub check_gid_for_uniqueness($) { return unless userbase_available(); printd "check_gid_for_uniqueness: '$_[0]'\n"; check_id_for_sql_safeness($_[0]); if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{group_table_name}` WHERE `id` = $_[0]") > 1) { die_nice("$0: error: more than one group record with id=$_[0]!\n"); } } # FC, UB, VL sub check_username_for_uniqueness($) { #printd "check_username_for_uniqueness: '$_[0]'\n"; check_username_for_sql_safeness($_[0]); if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE LOWER(`username`) = LOWER('$_[0]')") > 1) { die_nice("$0: error: more than one user record with username='$_[0]'!\n"); } } # FC, UB, VL sub check_groupname_for_uniqueness { return unless userbase_available(); printd "check_groupname_for_uniqueness($_[0])\n"; check_groupname_for_sql_safeness($_[0]); if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{group_table_name}` WHERE LOWER(`group`) = LOWER('$_[0]')") > 1) { die_nice("$0: error: more than one user record with groupname='$_[0]'!\n"); } } # FC, UB, VL sub user_is_member_of_group { my $userid = shift; my $group = shift; printd "user_is_member_of_group(): userid='$userid', group='$group'\n"; if(userbase_available() && $PREF{member_is_logged_in}) { check_groupname_for_sql_safeness($group); die_unless_numeric($userid,'userid'); return 1 if $group =~ /^$PREF{public_group_name}$/i; return 1 if $group =~ /^$PREF{member_group_name}$/i && enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE `id` = $userid;"); return enc_sql_select("SELECT COUNT(*) FROM `$PREF{group_table_name}` WHERE LOWER(`group`) = LOWER('$group') AND `members` REGEXP '(^|,)$userid(,|\$)'"); } else { return 1 if $group =~ /^$PREF{public_group_name}$/i; return 1 if $group =~ /^$PREF{member_group_name}$/i && $userid =~ /^-(2|3)$/; return 1 if $group =~ /^$PREF{admin_group_name}$/i && $userid == -3; } } # FC, UB, VL sub userbase_available { return ($PREF{internal_appname} eq 'userbase' || $PREF{integrate_with_userbase} =~ /yes/i); } # FC, UB, VL sub get_user_id($) { #printd "get_user_id('$_[0]')\n"; my $username = shift; if(userbase_available() && $username) { die_nice("Error: invalid username '$username'.\n") unless username_is_valid($username); check_username_for_uniqueness($username); # checks for sql safeness too. return enc_sql_select("SELECT `id` FROM `$PREF{user_table_name}` WHERE LOWER(`username`) = LOWER('$username')"); } else { if($PREF{admin_is_logged_in}) { return -3; } elsif($PREF{member_is_logged_in}) { return -2; } else { return -1; } # stranger. } } # FC, UB, VL sub get_member_ids_for_group { printd "get_member_ids_for_group($_[0])\n"; my $group = shift; check_groupname_for_sql_safeness($group); # every account is automatically a member of these groups. if($group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i) { my $statement = "SELECT `id` FROM `$PREF{user_table_name}`"; return $PREF{dbh}->selectall_hashref($statement, 'id'); } else { my $member_ids = enc_sql_select("SELECT `members` FROM `$PREF{group_table_name}` WHERE LOWER(`group`) = LOWER('$group')"); my %member_ids = map { $_ => 1 } split(/,/, $member_ids); return \%member_ids; } } # FC, UB, VL sub get_user_name($) { check_uid_for_uniqueness($_[0]); # checks for sql safeness too. return enc_sql_select("SELECT `username` FROM `$PREF{user_table_name}` WHERE `id` = $_[0]"); } # FC, UB, VL sub get_group_name($) { my $gid = shift; if(userbase_available()) { check_gid_for_uniqueness($gid); # checks for sql safeness too. return enc_sql_select("SELECT `group` FROM `$PREF{group_table_name}` WHERE `id` = $gid"); } else { if($gid == -1) { return $PREF{public_group_name}; } elsif($gid == -2) { return $PREF{member_group_name}; } elsif($gid == -3) { return $PREF{admin_group_name}; } else { die_nice("$PREF{internal_appname}: get_group_name(): invalid group ID '$gid'.\n"); } } } sub groupname_is_valid { return ($_[0] =~ /^[0-9A-Za-z_]+$/ && $_[0] =~ /^[A-Za-z]/ && length($_[0]) < $PREF{max_groupname_length}); } # FC, UB, VL sub hashedpw_is_valid { return $_[0] =~ /^[0-9A-Za-z]+$/ && length($_[0]) < $PREF{max_hashedpw_length}; } # FC, UB, VL sub sessionid_is_valid { return $_[0] =~ /^[0-9A-Za-z]+$/ && length($_[0]) < $PREF{max_hashedpw_length}; } # FC, UB, VL # FC, UB, VL sub username_is_valid { my $space = $PREF{allow_spaces_in_usernames} =~ /yes/i ? ' ' : ''; my $atsign = $PREF{allow_atsigns_in_usernames} =~ /yes/i ? '@' : ''; my $dot = $PREF{allow_dots_in_usernames} =~ /yes/i ? '.' : ''; my $dash = $PREF{allow_dashes_in_usernames} =~ /yes/i ? '-' : ''; return ($_[0] =~ /^[0-9A-Za-z_$space$atsign$dot$dash]+$/ && $_[0] =~ /\w/ && length($_[0]) < $PREF{max_username_length}); } sub check_hashedpw_for_sql_safeness { die_nice("Invalid hashed password: '$_[0]'") unless hashedpw_is_valid($_[0]); } # FC, UB, VL sub check_username_for_sql_safeness { die_nice("Invalid username: '$_[0]'") unless username_is_valid($_[0]); } # FC, UB, VL sub check_groupname_for_sql_safeness { die_nice("Invalid groupname: '$_[0]'") unless groupname_is_valid($_[0]); } # FC, UB, VL sub check_sessionid_for_sql_safeness { die_nice("Invalid session ID: '$_[0]'") unless sessionid_is_valid($_[0]); } # FC, UB, VL sub check_id_for_sql_safeness { die_nice("Invalid ID: '$_[0]'") unless $_[0] =~ /^(\d+|-[123])$/; } # FC, UB, VL # FC, UB sub get_groups_hash { printd "get_groups_hash('$_[0]')\n"; # If you pass in a uid, then the resulting hash will # also indicate which groups that user is a member of. # my $user_id = shift; my ($id, $group, $members, %groups) = (); if(userbase_available()) { my $sth = $PREF{dbh}->prepare("SELECT `id`, `group`, `members` FROM `$PREF{group_table_name}`"); $sth->execute(); $sth->bind_columns(\$id, \$group, \$members); while($sth->fetchrow_arrayref) { $groups{$group}{name} = $group; $groups{$group}{id} = $id; my $is_member = (); if($group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i) { $is_member = 1; } elsif($user_id =~ /^\d+$/) { $is_member = $members =~ /(^|,)$user_id(,|$)/; } $groups{$group}{is_member} = $is_member; } } else { $groups{$PREF{public_group_name}}{name} = $PREF{public_group_name}; $groups{$PREF{public_group_name}}{id} = -1; $groups{$PREF{public_group_name}}{is_member} = 1; # everyone's a member of the public. $groups{$PREF{member_group_name}}{name} = $PREF{member_group_name}; $groups{$PREF{member_group_name}}{id} = -2; $groups{$PREF{member_group_name}}{is_member} = 1 if $user_id =~ /^-(2|3)$/; $groups{$PREF{admin_group_name}}{name} = $PREF{admin_group_name}; $groups{$PREF{admin_group_name}}{id} = -3; $groups{$PREF{admin_group_name}}{is_member} = 1 if $user_id =~ /^-3$/; } return \%groups; } # UB+VL here. # FC*, VL sub login_features_enabled { if( ( action_restrictions_enabled() || custom_folder_perms_enabled() ) && ( $PREF{member_password_hash} =~ /\S/ || $PREF{admin_password_hash} =~ /\S/ || $PREF{integrate_with_userbase} =~ /yes/i || $PREF{integrate_with_existing_login_system} =~ /yes/i ) ) { return 1; } } # FC, VL sub action_restrictions_enabled { foreach my $pref (keys %PREF) { if($pref =~ /^groups_allowed_to_/) { # if one or more groups is specified, and it's not the public group by itself, then access restrictions are enabled. if($PREF{$pref} =~ /\w/ && $PREF{$pref} !~ /^\s*,?\s*$PREF{public_group_name}\s*,?\s*$/i) { return 1; } } } return 0; } # FC, VL sub make_password_hash { if($ENV{REQUEST_METHOD} =~ /post/i) { use CGI ':param'; my $hashed_password = md5_hex(param('password')); start_html_output('Here is your hashed password...', 'css', 'js'); print qq`
The hashed version of the password you just entered is:

$hashed_password
` . qq`\n`; finish_html_output('home', 'uploader', 'login'); } else { start_html_output('Enter your new password', 'css', 'js'); print qq`
` . qq`\nEnter your new password:` . qq`\n

` . qq`\n

` . qq`\n
` . qq`\n`; finish_html_output('home', 'uploader', 'login'); } } # FC, VL sub user_is_allowed_to { my $action = shift; if(!login_features_enabled()) { return 1; } else { foreach my $group (split(/\s*,\s*/, $PREF{"groups_allowed_to_$action"})) { return 1 if user_is_member_of_group($PREF{logged_in_userid}, $group); } return 0; } } # FC, VL sub exit_with_access_denied { my $target = shift; my $login_url = ''; my $auto_redirect = ''; if($PREF{integrate_with_userbase} =~ /yes/i || $PREF{integrate_with_existing_login_system} =~ /yes/i) { $login_url = $PREF{login_url}; $auto_redirect = qq`\n`; } else { $login_url = "$PREF{here_login}?action=login&target=$target"; } $login_url = "$PREF{protoprefix}$ENV{HTTP_HOST}$login_url" unless $login_url =~ /^https?:/; my $message = $PREF{member_is_logged_in} ? qq`Insufficient privileges to perform this action.` : qq`You must log in first.\n$auto_redirect`; start_html_output('Authentication Required', 'css', 'js'); print qq`

Authentication Required

` . qq`\n
$message
` . qq`\n`; finish_html_output('home', 'uploader', 'list'); exit; } ############################################################################################################################################ ### Begin main block. ############################################################################################################################################ load_prefs(); if($qs =~ /action=get_progress_and_size/) { print "Cache-Control: no-store, no-cache\n"; print "Content-type: text/xml\n\n"; my $output = ''; my ($serial) = ($qs =~ /(?:^|&)serial=([0-9a-zA-Z]+)(?:&|$)/); if(!$serial) { $output = "ERROR: the URL is missing its serial number (serial=NNNNNN...)."; } else { my $fcvar = get_progress_and_size($serial); if($$fcvar{progress} eq 'ENOLOG') { $output = "ERROR: the log file hasn't been created yet; your server is probably doing some write-caching so the log doesn't get created when we create it -- it actually gets created AFTER the upload is complete, making progress reporting impossible."; } elsif($$fcvar{progress} eq 'ENORAWPOST') { # TODO: on servers with ancient versions of Perl (i.e. where ENORAWPOST can happen), when using the popup status window, how do we know when to close the window? $output = "ERROR: the rawpost file hasn't been created yet; your server is probably doing some write-caching so the file doesn't get created when we create it -- it actually gets created AFTER the upload is complete, making progress reporting impossible."; } else { if($$fcvar{total_size} > $CGI::POST_MAX) { $$fcvar{size_error} = 'toobig'; $$fcvar{size_limit} = $CGI::POST_MAX; } if(data_exceeds_global_quota($$fcvar{total_size})) { $$fcvar{size_error} = 'globalquotaexceeded'; $$fcvar{size_limit} = $PREF{quota_for_entire_upload_directory}; } if(data_exceeds_user_quota($$fcvar{total_size})) { $$fcvar{size_error} = 'userquotaexceeded'; $$fcvar{size_limit} = $PREF{quota_for_member_userdirs}; } foreach my $var (sort keys %$fcvar) { $output .= "$var=$$fcvar{$var}|:|:|"; } } } #print qq`\n\n`; print qq`\n\n`; print $output; print qq`\n\n`; } elsif($qs =~ /ajax_get_serial/) { print "Cache-Control: no-store, no-cache\n"; print "Content-type: text/xml\n\n"; print qq`\n\n`; print generate_serial_number(); print qq`\n\n`; } elsif($qs =~ /ajax_do_humantest&fcht1=(.+)&fcht2=(.+?)(?:&|$)/) { my $passed_test = do_human_test($1,$2); print "Cache-Control: no-store, no-cache\n"; print "Content-type: text/xml\n\n"; print qq`\n\n`; print $passed_test ? 'passed=true' : 'passed=false'; print qq`\n\n`; } elsif($qs =~ /(?:^|&)action=uploadcomplete(?:&|$)/) { show_uploadcomplete_page(); } elsif($qs =~ /(?:^|&)action=view_items(?:&|$)/) { view_items(); } elsif($qs =~ /(?:^|&)action=showperms&item=(.+?)(?:&|$)/) { show_permissions($1); } elsif($qs =~ /(?:^|&)action=changeperms(?:&|$)/) { change_permissions(); } elsif($qs =~ /(?:^|&)action=process_order(?:&|$)/) { process_order(); } elsif($qs =~ /(?:^|&)action=showallperms(?:&|$)/) { show_all_permissions(); } elsif($qs =~ /(?:^|&)action=order_confirmation(?:&|$)/) { order_confirmation(); } elsif($qs =~ /(?:^|&)action=loggedout&whence=(.*)(?:&|$)/) { # note that the whence regex is .* not .*? because the value # will likely contain ampersands that we want to keep. show_loggedout_page($1); } #elsif($qs eq 'get_logo') #{ # my $logo = get_logo(); # print "Content-type: image/png\n"; # print "Content-transfer-encoding: binary\n\n"; # print `uudecode -o /dev/stdout $logo`; #} elsif($qs =~ /action=delete(?:&path=(.*?))?&(file|folder)=(.+?)(&really=yes)?(?:&|$)/) { delete_item($1,$2,$3,$4); } elsif($qs =~ /action=(move|rename)&(file|folder)=(.+?)&src=(.*?)(?:&dst=(.+?))?(?:&|$)/) { move_item($1,$2,$3,$4,$5); } elsif($qs =~ /action=fileinfo&path=(.*?)&file=(.+?)(?:&|$)/) { if($PREF{store_upload_info_in_files__oldformat} =~ /yes/i) { show_fileinfo__oldformat($1, $2); } else { show_fileinfo($1, $2); } } elsif($qs =~ /action=$PREF{upload_session_info_action_name}(?:&|$)/) { show_upload_session_info(); } elsif($qs =~ /action=download&path=(.*?)&file=(.+?)(?:&|$)/) { download_file($1, $2); } elsif($qs =~ /action=$PREF{mkdir_action_name}(?:&path=(.+?)(?:&dirname=(.+))?)?(?:&|$)/) { make_dir($1,$2); } elsif($qs =~ /action=unzip_files&path=(.*?)(?:&|$)/) { unzip_files($1); } elsif($qs =~ /action=rotate_images(\d+)&path=(.*?)(?:&|$)/) { rotate_images($1,$2); } elsif($qs =~ /action=delete_items&path=(.*?)(?:&|$)/) { delete_items($1); } elsif($qs =~ /action=incoming/i) { process_upload(); } elsif($qs =~ /(?:^|&)(list|action=listfiles)(?:&|$)/) { list_uploaded_files(); } elsif($qs =~ /(?:^|&)action=upload(?:&|$)/) { print_new_upload_form(); } else { if($PREF{default_page} eq 'filelist') { list_uploaded_files(); } else { print_new_upload_form(); } } #printd "fcruntime=" . (gettimeofday() - $hires_start) . "\n";