← Back to branch summary

~ubuntu-branches/ubuntu/lucid/w3m/lucid-updates

« back to all changes in this revision

Viewing changes to scripts/multipart/multipart.cgi.in

  • Committer: Bazaar Package Importer
  • Author(s): Fumitoshi UKAI
  • Date: 2004-04-29 03:28:41 UTC
  • Revision ID: james.westby@ubuntu.com-20040429032841-uo4mu7a813aqrua8
Tags: upstream-0.5.1
Import upstream version 0.5.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/multipart/multipart.cgi.in
 
1
#!@PERL@
 
2
 
 
3
eval "use NKF;";
 
4
if (! $@) {
 
5
        $use_NKF = 1;
 
6
        $CONV = "-e";
 
7
        $MIME_DECODE = "-m -e";
 
8
} else {
 
9
        $use_NKF = 0;
 
10
#       $CONV = "w3m -dump -e";
 
11
        $CONV = "@NKF@ -e";
 
12
        $MIME_DECODE = "@NKF@ -m -e";
 
13
}
 
14
$MIME_TYPE = "$ENV{'HOME'}/.mime.types";
 
15
 
 
16
$SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0;
 
17
$CGI = "file://$SCRIPT_NAME";
 
18
 
 
19
if ($ENV{'REQUEST_METHOD'} eq 'POST') {
 
20
        sysread(STDIN, $query, $ENV{'CONTENT_LENGTH'});
 
21
} elsif (defined($ENV{'QUERY_STRING'})) {
 
22
        $query = $ENV{'QUERY_STRING'};
 
23
}
 
24
if (defined($query)) {
 
25
        for (split('&', $query)) {
 
26
                s/^([^=]*)=//;
 
27
                $v{$1} = $_;
 
28
        }
 
29
        $file = &form_decode($v{'file'});
 
30
        $boundary = &form_decode($v{'boundary'});
 
31
} else {
 
32
        $file = $ARGV[0];
 
33
        if (@ARGV >= 2) {
 
34
                $boundary = $ARGV[1];
 
35
        }
 
36
}
 
37
(-f $file) || exit(1);
 
38
open(F, "< $file") || exit(1);
 
39
$end = 0;
 
40
$mbody = '';
 
41
if (defined($boundary)) {
 
42
        while(<F>) {
 
43
                s/\r?\n$//;
 
44
                ($_ eq "--$boundary") && last;
 
45
                ($_ eq "--$boundary--") && ($end = 1, last);
 
46
                $mbody .= "$_\n";
 
47
        }
 
48
} else {
 
49
        while(<F>) {
 
50
                s/\r?\n$//;
 
51
                if (s/^\-\-//) {
 
52
                        $boundary = $_;
 
53
                        last;
 
54
                }
 
55
                $mbody .= "$_\n";
 
56
        }
 
57
}
 
58
 
 
59
if (defined($v{'count'})) {
 
60
        $count = 0;
 
61
        while($count < $v{'count'}) {
 
62
                while(<F>) {
 
63
                        s/\r?\n$//;
 
64
                        ($_ eq "--$boundary") && last;
 
65
                }
 
66
                eof(F) && exit;
 
67
                $count++;
 
68
        }
 
69
 
 
70
        %header = ();
 
71
        $hbody = '';
 
72
        while(<F>) {
 
73
                /^\s*$/ && last;
 
74
                $x = $_;
 
75
                s/\r?\n$//;
 
76
                if (/=\?/) {
 
77
                        $_ = &decode($_, $MIME_DECODE);
 
78
                }
 
79
                if (s/^(\S+)\s*:\s*//) {
 
80
                        $h = $&;
 
81
                        if ($h =~ /^w3m-control/i) {
 
82
                                $h = "WARNING: $h";
 
83
                        }
 
84
                        $hbody .= "$h$_\n";
 
85
                        $p = $1;
 
86
                        $p =~ tr/A-Z/a-z/;
 
87
                        $header{$p} = $_;
 
88
                } elsif (s/^\s+//) {
 
89
                        chop $hbody;
 
90
                        $hbody .= "$_\n";
 
91
                        $header{$p} .= $_;
 
92
                }
 
93
        }
 
94
        $type = $header{"content-type"};
 
95
        $dispos = $header{"content-disposition"};
 
96
        if ($type =~ /application\/octet-stream/) {
 
97
                if ($type =~ /type\=gzip/) {
 
98
                        print "Content-Encoding: x-gzip\n";
 
99
                }
 
100
                if ($type =~ /name=\"?([^\"]+)\"?/ ||
 
101
                        $dispos =~ /filename=\"?([^\"]+)\"?/) {
 
102
                        $type = &guess_type($1);
 
103
                        if ($type) {
 
104
                                print "Content-Type: $type; name=\"$1\"\n";
 
105
                        } else {
 
106
                                print "Content-Type: text/plain; name=\"$1\"\n";
 
107
                        }
 
108
                }
 
109
        }
 
110
        print $hbody;
 
111
        print "\n";
 
112
        while(<F>) {
 
113
                $x = $_;
 
114
                s/\r?\n$//;
 
115
                ($_ eq "--$boundary") && last;
 
116
                if ($_ eq "--$boundary--") {
 
117
                        last;
 
118
                }
 
119
                print $x;
 
120
        }
 
121
        close(F);
 
122
        exit;
 
123
}
 
124
 
 
125
$qcgi = &html_quote($CGI);
 
126
$qfile = &html_quote($file);
 
127
$qboundary = &html_quote($boundary);
 
128
 
 
129
if ($mbody =~ /\S/) {
 
130
        $_ = $mbody;
 
131
        s/\&/\&amp;/g;
 
132
        s/\</\&lt;/g;
 
133
        s/\>/\&gt;/g;
 
134
        print "<pre>\n";
 
135
        print $_;
 
136
        print "</pre>\n";
 
137
}
 
138
 
 
139
$count = 0;
 
140
while(! $end) {
 
141
        %header = ();
 
142
        $hbody = '';
 
143
        while(<F>) {
 
144
                /^\s*$/ && last;
 
145
                s/\r?\n$//;
 
146
                if (/=\?/) {
 
147
                        $_ = &decode($_, $MIME_DECODE);
 
148
                }
 
149
                if (s/^(\S+)\s*:\s*//) {
 
150
                        $hbody .= "$&$_\n";
 
151
                        $p = $1;
 
152
                        $p =~ tr/A-Z/a-z/;
 
153
                        $header{$p} = $_;
 
154
                } elsif (s/^\s+//) {
 
155
                        chop $hbody;
 
156
                        $hbody .= "$_\n";
 
157
                        $header{$p} .= $_;
 
158
                }
 
159
        }
 
160
        $type = $header{"content-type"};
 
161
        $dispos = $header{"content-disposition"};
 
162
        $plain = 0;
 
163
        $image = 0;
 
164
        if (! $dispos || $dispos =~ /^inline/i) {
 
165
                if (! $type || $type =~ /^text\/plain/i) {
 
166
                        $plain = 1;
 
167
                } elsif ($type =~ /^image\//i) {
 
168
                        $image = 1;
 
169
                }
 
170
        }
 
171
        $body = '';
 
172
        while(<F>) {
 
173
                s/\r?\n$//;
 
174
                ($_ eq "--$boundary") && last;
 
175
                if ($_ eq "--$boundary--") {
 
176
                        $end = 1;
 
177
                        last;
 
178
                }
 
179
                if ($plain) {
 
180
                        $body .= "$_\n";
 
181
                }
 
182
        }
 
183
        $| = 1;
 
184
        print "<hr>\n";
 
185
        {
 
186
                $_ = $hbody;
 
187
                s/\&/\&amp;/g;
 
188
                s/\</\&lt;/g;
 
189
                s/\>/\&gt;/g;
 
190
                print "<pre>\n";
 
191
                print $_;
 
192
                print "</pre>\n";
 
193
                if ($type =~ /name=\"?([^\"]+)\"?/ ||
 
194
                        $dispos =~ /filename=\"?([^\"]+)\"?/) {
 
195
                        $name = $1;
 
196
                } else {
 
197
                        $name = "Content";
 
198
                }
 
199
                print "<form action=\"$qcgi\">\n";
 
200
                print "<input type=hidden name=file value=\"$qfile\">\n";
 
201
                print "<input type=hidden name=boundary value=\"$qboundary\">\n";
 
202
                print "<input type=hidden name=count value=\"$count\">\n";
 
203
                if ($image) {
 
204
                        print "<input type=image name=submit src=\"$qcgi?file=",
 
205
                                &html_quote(&form_encode($file)),
 
206
                                "&amp;boundary=",
 
207
                                &html_quote(&form_encode($boundary)),
 
208
                                "&amp;count=$count\" alt=\"",
 
209
                                &html_quote($name), "\">\n";
 
210
                } else {
 
211
                        print "<input type=submit name=submit value=\"",
 
212
                                &html_quote($name), "\">\n";
 
213
                }
 
214
                print "</form>\n"
 
215
        }
 
216
        if ($plain) {
 
217
                $body = &decode($body, $CONV); 
 
218
                $_ = $body;
 
219
                s/\&/\&amp;/g;
 
220
                s/\</\&lt;/g;
 
221
                s/\>/\&gt;/g;
 
222
                print "<pre>\n\n";
 
223
                print $_;
 
224
                print "</pre>\n";
 
225
        }
 
226
        eof(F) && last;
 
227
        $count++;
 
228
}
 
229
close(F);
 
230
 
 
231
sub decode {
 
232
if ($use_NKF) {
 
233
        local($body, $opt) = @_;
 
234
        return nkf($opt, $body);
 
235
}
 
236
        local($body, @cmd) = @_;
 
237
        local($_);
 
238
 
 
239
        $| = 1;
 
240
        pipe(R, W2);
 
241
        pipe(R2, W);
 
242
        if (! fork()) {
 
243
                close(F);
 
244
                close(R);
 
245
                close(W);
 
246
                open(STDIN, "<&R2");
 
247
                open(STDOUT, ">&W2");
 
248
                exec @cmd;
 
249
                die;
 
250
        }
 
251
        close(R2);
 
252
        close(W2);
 
253
        print W $body;
 
254
        close(W);
 
255
        $body = '';
 
256
        while(<R>) {
 
257
                $body .= $_;
 
258
        }
 
259
        close(R);
 
260
        return $body;
 
261
}
 
262
 
 
263
sub html_quote {
 
264
  local($_) = @_;
 
265
  local(%QUOTE) = (
 
266
    '<', '&lt;',
 
267
    '>', '&gt;',
 
268
    '&', '&amp;',
 
269
    '"', '&quot;',
 
270
  );
 
271
  s/[<>&"]/$QUOTE{$&}/g;
 
272
  return $_;
 
273
}
 
274
 
 
275
sub form_decode {
 
276
  local($_) = @_;
 
277
  s/\+/ /g;
 
278
  s/%([\da-f][\da-f])/pack('c', hex($1))/egi;
 
279
  return $_;
 
280
}
 
281
 
 
282
sub form_encode {
 
283
  local($_) = @_;
 
284
  s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg;
 
285
  return $_;
 
286
}
 
287
 
 
288
sub guess_type {
 
289
        local($_) = @_;
 
290
 
 
291
        /\.(\w+)$/ || return "";
 
292
        $_ = $1;
 
293
        tr/A-Z/a-z/;
 
294
        %mime_type = &load_mime_type($MIME_TYPE);
 
295
        $mime_type{$_};
 
296
}
 
297
 
 
298
sub load_mime_type {
 
299
        local($file) = @_;
 
300
        local(%m, $a, @b, $_);
 
301
 
 
302
        open(M, "< $file") || return ();
 
303
        while(<M>) {
 
304
                /^#/ && next;
 
305
                chop;
 
306
                (($a, @b) = split(" ")) >= 2 || next;
 
307
                for(@b) {
 
308
                        $m{$_} = $a;
 
309
                }
 
310
        }
 
311
        close(M);
 
312
        return %m;
 
313
}