forked from github/kensanata.oddmuse
83f13a9a1a
As we derive a lot of filenames from strings in UTF-8 encoded files, we need to make sure that any filename that might might be set by a user – including all the filenames containing a directory deriving from $DataDir – are passed through utf8::encode. That is, every character gets replaced with a sequence of one or more characters that represent the individual bytes of the character and the UTF8 flag is turned off. In other words, -d $DataDir might not work if $DataDir contains a UTF-8 encoded string. The solution is to use the following replacements: -f $name IsFile($name) -e $name IsFile($name) -d $name IsDir($name) (stat($name))[9] Modified($name) -M $name $Now - Modified($name) -z $name ZeroSize($name) unlink $name Unlink($name) mkdir $name CreateDir($name) rmdir $name RemoveDir($name) (Using IsFile for -e is probably not ideal?) If you don’t, and Oddmuse gets used with Mojolicious, and you use the Namespaces Extension, and a namespace contains non-ASCII characters such as ä, ö, or ü, these characters will end up as part of $DataDir and trigger the problem. I also wonder whether we should be using some other Perl library.
93 lines
2.9 KiB
Perl
93 lines
2.9 KiB
Perl
#!/usr/bin/perl -T
|
|
# Copyright (C) 2014 Alex-Daniel Jakimenko <alex.jakimenko@gmail.com>
|
|
|
|
# This program is free software: you can redistribute it and/or modify it under
|
|
# the terms of the GNU General Public License as published by the Free Software
|
|
# Foundation, either version 3 of the License, or (at your option) any later
|
|
# version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful, but WITHOUT
|
|
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License along with
|
|
# this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
use strict;
|
|
use v5.10;
|
|
use CGI;
|
|
#use CGI::Carp qw ( fatalsToBrowser );
|
|
use File::Basename;
|
|
|
|
AddModuleDescription('upload.pl');
|
|
|
|
$CGI::POST_MAX = 1024 * 100000;
|
|
my $filenameWhitelist = 'a-zA-Z0-9_.-';
|
|
my @additionalChars = ('A'..'Z', 'a'..'z', '0'..'9');
|
|
my $urlStart = 'http://files.YOURDOMAIN.org/'; # CHANGE THIS
|
|
my $uploadDir = '../upload/';
|
|
my $logFile = '../upload.log';
|
|
my %keys = qw(justletmeupload you); # CHANGE THIS
|
|
|
|
sub squeak {
|
|
say shift;
|
|
die;
|
|
}
|
|
|
|
my $q = new CGI;
|
|
print $q->header();
|
|
|
|
if (not exists $keys{$q->param("key")}) {
|
|
squeak 'Error: Not authorized to upload';
|
|
}
|
|
|
|
if (not $q->param("fileToUpload0")) {
|
|
squeak 'Error: There was a problem uploading your file (try a smaller file)';
|
|
}
|
|
|
|
for (my $i=0; $q->param("fileToUpload$i"); $i++) {
|
|
if ($i >= 100) { # Uploading more than 100 files? What?
|
|
squeak 'Error: Cannot upload more than 100 files at once';
|
|
}
|
|
|
|
my $curFilename = substr $q->param("fileToUpload$i"), -100;
|
|
|
|
my($name, $path, $extension) = fileparse($curFilename, '\..*');
|
|
$name =~ tr/ /_/;
|
|
$name =~ s/[^$filenameWhitelist]//g;
|
|
$extension =~ tr/ /_/;
|
|
$extension =~ s/[^$filenameWhitelist]//g;
|
|
|
|
$curFilename = $name . $extension;
|
|
|
|
while (IsFile("$uploadDir/$curFilename")) { # keep adding random characters until we get unique filename
|
|
squeak 'Error: Cannot save file with such filename' if length $curFilename >= 150; # cannot find available filename after so many attempts
|
|
$name .= $additionalChars[rand @additionalChars];
|
|
$curFilename = $name . $extension;
|
|
}
|
|
|
|
if ($curFilename =~ /^([$filenameWhitelist]+)$/) { # filename is already safe, but we have to untaint it
|
|
$curFilename = $1;
|
|
} else {
|
|
squeak 'Error: Filename contains invalid characters'; # this should not happen
|
|
}
|
|
|
|
open(my $LOGFILE, '>>', $logFile) or squeak "$!";
|
|
print $LOGFILE $q->param("key") . ' ' . $ENV{REMOTE_ADDR} . ' ' . $curFilename . "\n";
|
|
close $LOGFILE;
|
|
|
|
my $uploadFileHandle = $q->upload("fileToUpload$i");
|
|
|
|
open(my $UPLOADFILE, '>', "$uploadDir/$curFilename") or squeak "$!";
|
|
binmode $UPLOADFILE;
|
|
while (<$uploadFileHandle>) {
|
|
print $UPLOADFILE;
|
|
}
|
|
close $UPLOADFILE;
|
|
if ($q->param("nameOnly")) {
|
|
print "$curFilename\n";
|
|
} else {
|
|
print "$urlStart$curFilename\n";
|
|
}
|
|
}
|