/
Upload.pm
137 lines (112 loc) · 3.6 KB
/
Upload.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
package Upload;
use lib '.';
use Core::Serialize;
my $UPLOAD_DIR = "papers"; # TODO: move to a "safe" location
$CGI::POST_MAX = 10 * 1024 * 1024; # Limit uploads to 10 MB
my $MAX_DIR_SIZE = 250 * 1024 * 1024; # Maximum upload directory size. Limit total uploads to 250 MB
my $MAX_OPEN_TRIES = 100; # Number of times we attempt create a unique filename
sub save {
my ($path) = @_;
# check file type
# DONE: relax by checking for extension of file (to deal with browsers
# that don't set the correct content type)
# NOTE: Used this code previously to check content type
# my $info = $::q->uploadInfo($path);
# unless ($info->{"Content-Type"} =~ /application\/(pdf|msword)/) {
# ::handleError("Can only upload PDF or Word documents: " + $path);
# }
$path =~ /(\.\w+)$/ || ::handleError("Bad file extension");
my $fileExtension = $1;
unless ($fileExtension eq ".doc" || $fileExtension eq ".docx" || $fileExtension eq ".pdf" ||
$fileExtension eq ".txt") { # 09-02-12 mw added support for .txt files
::handleError("Can only upload PDF, Word or text documents: " . $path);
}
# print "<p>path: $path</p>";
# print "<p>length: $ENV{CONTENT_LENGTH}</p>";
# DONE: check directory size
if (directorySize($UPLOAD_DIR) + $ENV{CONTENT_LENGTH} > $MAX_DIR_SIZE) {
::handleError("Upload directory is full. Please inform $::WEBCHAIR_EMAIL.");
}
# DONE: create a reference for a new submission
unless ($::q->param("reference")) {
$::q->param("reference" => Serialize::getReference());
}
# DONE: construct file name from reference
unless ($::q->param("reference") =~ /(\d+)/) {
::handleError("Bad reference");
}
my $reference = $1;
my $fileName = $reference . $fileExtension;
# get file handle
my $fh = $::q->upload("paper") ||
::handle("Could not obtain file handle: $h");
unless ($fh) {
::handleError("Invalid file");
}
my $size = fileSize($fh);
# print "<p>File size: $size</p>";
# DONE: find unique file name
# DONE: replace sysopen with open (which works), and check for existing file names with -e
# TODO: protect against race condition (-e, other process: -e, both open same file)
# MOVE: if one version in .doc, the other in .pdf they are not treated as separate versions,
# because currently I am only checking for existence of $ref.$type, whereas I should check for
# $ref.ANY (ANY = any of the allowed formats)
my $version;
while (-e "$UPLOAD_DIR/$fileName") {
if ($fileName =~ /(.+\.)(\d*)(\.\w+)$/) {
$version = $2 + 1;
$fileName = $1 . $version . $3;
if ($version >= $MAX_OPEN_TRIES) {
::handleError("Unable to save your file: $fileName");
}
} else {
$fileName =~ s/(\.\w+)$/\.1$1/;
$unique = 1;
}
}
# DONE: write contents to output file
binmode FILE;
open FILE, ">papers/$fileName" ||
::handleError("Unable to save your file: $fileName");
while (<$fh>) {
print FILE;
}
close FILE;
my @status = ($fileName, $size, $version);
return @status;
}
# Utilities
sub directorySize {
my ($directory) = @_;
my $total = 0;
open DIR, $directory || die $!;
while (readdir DIR) {
$total += -s "$directory/$_";
}
return $total;
}
sub fileSize {
my ($fh) = @_;
seek($fh, 0, 2); # move position to end of file
my $size = tell($fh);
seek($fh, 0, 0); # reset position
return $size;
}
# Debug
sub tmpFileName {
# uses private API of CGI.pm
my ($path) = @_;
my $fileName = $::q->tmpFileName($path);
print "<p>Save: $fileName</p>";
}
sub copyTmpFile {
# uses private API of CGI.pm
my ($path, $to) = @_;
my $fileName = $::q->tmpFileName($path);
copy($from, $to);
}
sub uploadInfo {
my ($path) = @_;
::dumpRecord($::q->uploadInfo($path));
}
1;