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
|
# This is _getargs, a Perl/CGI argument reader capable of retrieving RFC1867 file uploads
# as well as "normal" URL-encoded input.
# (c) Vivtek 2000. Licensed under the terms of the GNU Public License.
# Documentation at http://www.vivtek.com/cgi/getargs.html
#
# You may freely use and copy this code for any purpose, as long as this comment block
# remains attached exactly as it is. Modified forms of this code must clearly state the
# fact that they're modified. This code is distributed with no warranty at all -- if it
# breaks, it's not my problem. If it breaks your system, it's still not my problem.
sub getargs {
# Grab the query string
my $input = $ENV{QUERY_STRING};
# Decode any URL form encoding, add onto query string
if (lc($ENV{CONTENT_TYPE}) eq 'application/x-www-form-urlencoded') {
$input .= "&" if $input ne '';
while (<>) {
chomp;
$input .= $_;
}
}
my $i;
my @t;
my %tagset;
# Iterate through each query argument from the input string
foreach $i (split /&/, $input) {
# Split the query argument into key/value
@t = split /=/, $i, 2;
# Replace + with spaces
$t[1] =~ tr/+/ /;
# Translate hex into chars
$t[1]=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Set tag for this CGI arg
$tagset{$t[0]} = $t[1];
}
# Bail out and return this if it's not a multipart form slash file submit
return \%tagset if (lc($ENV{CONTENT_TYPE}) !~ m'multipart/form-data;');
# Ugly multi-file upload shit to follow
my $line;
my $lines;
my $name;
my $type;
my $filename;
my $file = 0;
my $localname;
my $uploads = shift @_;
my ($junk,$boundary) = split /=/, $ENV{CONTENT_TYPE}, 2;
$boundary =~ s/\n//;
$boundary = "--$boundary";
LINE: while (<>) {
last if ($_ eq "${boundary}--\r\n");
if ($_ eq "$boundary\r\n") {
$line=<>; # Get first line of headers.
$line =~ s/.*?; //; # Chop off the Content-Disposition part, we don't need it.
($name, $filename) = split /; /, $line, 2;
($junk, $name) = split /"/, $name;
close _GETARGS_TEMP;
$file = 0;
$lines = 0;
if ($filename ne "") {
$file = 1;
($junk, $filename) = split /"/, $filename;
$tagset{"_details_$name"} = $filename;
$line=<>;
chomp $line;
($junk, $type) = split ": ", $line;
$type =~ s/\r*//g;
$tagset{"_details_$name"} .= "|" . $type;
$ext = $$uploads{mime}{$type};
if ($ext eq '') {
$ext = $filename;
$ext =~ s/^.*\.//;
}
$tagset{$name} = getargs_makefilename ($$uploads{file}, \%tagset, $filename);
# if ($ext ne '') { $tagset{$name} .= ".$ext"; }
$localname = "$$uploads{base}/$tagset{$name}";
if ($localname ne '') {
if (open _GETARGS_TEMP, ">$localname") {
$tagset{"_details_$name"} .= "|" . $localname;
chmod 0644, $localname;
}
}
}
while ($line=<>) { next LINE if $line == "\n"; }
}
if ($file) {
# Write the line to the temp file.
print _GETARGS_TEMP $_;
} else {
s/[\r\n]*$//;
if ($lines > 0) {$tagset{$name} .= "\n"; }
$tagset{$name} .= $_;
$lines ++;
}
}
close _GETARGS_TEMP;
return \%tagset;
}
sub getargs_makefilename {
my $spec = shift(@_);
my $object = shift(@_);
my $field = shift(@_);
while ($spec =~ /\[(.*?)\]/) {
$tag = $1;
if ($tag eq '(field)') {
$val = $field;
} else {
$val = $$object{$tag};
}
# $val =~ tr/ /_/;
$val =~ s/[&!"'*;]//g;
$val =~ s/\\//g;
$val =~ s/://g;
$tag =~ s/\(/\\(/g;
$tag =~ s/\)/\\)/g;
$spec =~ s/\[$tag\]/$val/g;
}
return $spec;
}
1;
|
