event refactor, landing on HEAD!
[freeside.git] / httemplate / elements / fckeditor / editor / filemanager / browser / default / connectors / perl / upload_fck.pl
1 #####\r
2 #  FCKeditor - The text editor for Internet - http://www.fckeditor.net\r
3 #  Copyright (C) 2003-2007 Frederico Caldeira Knabben\r
4 #\r
5 #  == BEGIN LICENSE ==\r
6 #\r
7 #  Licensed under the terms of any of the following licenses at your\r
8 #  choice:\r
9 #\r
10 #   - GNU General Public License Version 2 or later (the "GPL")\r
11 #     http://www.gnu.org/licenses/gpl.html\r
12 #\r
13 #   - GNU Lesser General Public License Version 2.1 or later (the "LGPL")\r
14 #     http://www.gnu.org/licenses/lgpl.html\r
15 #\r
16 #   - Mozilla Public License Version 1.1 or later (the "MPL")\r
17 #     http://www.mozilla.org/MPL/MPL-1.1.html\r
18 #\r
19 #  == END LICENSE ==\r
20 #\r
21 #  This is the File Manager Connector for Perl.\r
22 #####\r
23 \r
24 # image data save dir\r
25 $img_dir        = './temp/';\r
26 \r
27 \r
28 # File size max(unit KB)\r
29 $MAX_CONTENT_SIZE =  30000;\r
30 \r
31 # Filelock (1=use,0=not use)\r
32 $PM{'flock'}            = '1';\r
33 \r
34 \r
35 # upload Content-Type list\r
36 my %UPLOAD_CONTENT_TYPE_LIST = (\r
37         'image/(x-)?png'                                                =>      'png',  # PNG image\r
38         'image/p?jpe?g'                                                 =>      'jpg',  # JPEG image\r
39         'image/gif'                                                             =>      'gif',  # GIF image\r
40         'image/x-xbitmap'                                               =>      'xbm',  # XBM image\r
41 \r
42         'image/(x-(MS-)?)?bmp'                                  =>      'bmp',  # Windows BMP image\r
43         'image/pict'                                                    =>      'pict', # Macintosh PICT image\r
44         'image/tiff'                                                    =>      'tif',  # TIFF image\r
45         'application/pdf'                                               =>      'pdf',  # PDF image\r
46         'application/x-shockwave-flash'                 =>      'swf',  # Shockwave Flash\r
47 \r
48         'video/(x-)?msvideo'                                    =>      'avi',  # Microsoft Video\r
49         'video/quicktime'                                               =>      'mov',  # QuickTime Video\r
50         'video/mpeg'                                                    =>      'mpeg', # MPEG Video\r
51         'video/x-mpeg2'                                                 =>      'mpv2', # MPEG2 Video\r
52 \r
53         'audio/(x-)?midi?'                                              =>      'mid',  # MIDI Audio\r
54         'audio/(x-)?wav'                                                =>      'wav',  # WAV Audio\r
55         'audio/basic'                                                   =>      'au',   # ULAW Audio\r
56         'audio/mpeg'                                                    =>      'mpga', # MPEG Audio\r
57 \r
58         'application/(x-)?zip(-compressed)?'    =>      'zip',  # ZIP Compress\r
59 \r
60         'text/html'                                                             =>      'html', # HTML\r
61         'text/plain'                                                    =>      'txt',  # TEXT\r
62         '(?:application|text)/(?:rtf|richtext)' =>      'rtf',  # RichText\r
63 \r
64         'application/msword'                                    =>      'doc',  # Microsoft Word\r
65         'application/vnd.ms-excel'                              =>      'xls',  # Microsoft Excel\r
66 \r
67         ''\r
68 );\r
69 \r
70 # Upload is permitted.\r
71 # A regular expression is possible.\r
72 my %UPLOAD_EXT_LIST = (\r
73         'png'                                   =>      'PNG image',\r
74         'p?jpe?g|jpe|jfif|pjp'  =>      'JPEG image',\r
75         'gif'                                   =>      'GIF image',\r
76         'xbm'                                   =>      'XBM image',\r
77 \r
78         'bmp|dib|rle'                   =>      'Windows BMP image',\r
79         'pi?ct'                                 =>      'Macintosh PICT image',\r
80         'tiff?'                                 =>      'TIFF image',\r
81         'pdf'                                   =>      'PDF image',\r
82         'swf'                                   =>      'Shockwave Flash',\r
83 \r
84         'avi'                                   =>      'Microsoft Video',\r
85         'moo?v|qt'                              =>      'QuickTime Video',\r
86         'm(p(e?gv?|e|v)|1v)'    =>      'MPEG Video',\r
87         'mp(v2|2v)'                             =>      'MPEG2 Video',\r
88 \r
89         'midi?|kar|smf|rmi|mff' =>      'MIDI Audio',\r
90         'wav'                                   =>      'WAVE Audio',\r
91         'au|snd'                                =>      'ULAW Audio',\r
92         'mp(e?ga|2|a|3)|abs'    =>      'MPEG Audio',\r
93 \r
94         'zip'                                   =>      'ZIP Compress',\r
95         'lzh'                                   =>      'LZH Compress',\r
96         'cab'                                   =>      'CAB Compress',\r
97 \r
98         'd?html?'                               =>      'HTML',\r
99         'rtf|rtx'                               =>      'RichText',\r
100         'txt|text'                              =>      'Text',\r
101 \r
102         ''\r
103 );\r
104 \r
105 \r
106 # sjis or euc\r
107 my $CHARCODE = 'sjis';\r
108 \r
109 $TRANS_2BYTE_CODE = 0;\r
110 \r
111 ##############################################################################\r
112 # Summary\r
113 #\r
114 # Form Read input\r
115 #\r
116 # Parameters\r
117 # Returns\r
118 # Memo\r
119 ##############################################################################\r
120 sub read_input\r
121 {\r
122 eval("use File::Copy;");\r
123 eval("use File::Path;");\r
124 \r
125         my ($FORM) = @_;\r
126 \r
127 \r
128         mkdir($img_dir,0777);\r
129         chmod(0777,$img_dir);\r
130 \r
131         undef $img_data_exists;\r
132         undef @NEWFNAMES;\r
133         undef @NEWFNAME_DATA;\r
134 \r
135         if($ENV{'CONTENT_LENGTH'} > 10000000 || $ENV{'CONTENT_LENGTH'} > $MAX_CONTENT_SIZE * 1024) {\r
136                 &upload_error(\r
137                         'Size Error',\r
138                         sprintf(\r
139                                 "Transmitting size is too large.MAX <strong>%d KB</strong> Now Size <strong>%d KB</strong>(<strong>%d bytes</strong> Over)",\r
140                                 $MAX_CONTENT_SIZE,\r
141                                 int($ENV{'CONTENT_LENGTH'} / 1024),\r
142                                 $ENV{'CONTENT_LENGTH'} - $MAX_CONTENT_SIZE * 1024\r
143                         )\r
144                 );\r
145         }\r
146 \r
147         my $Buffer;\r
148         if($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {\r
149                 # METHOD POST only\r
150                 return  unless($ENV{'CONTENT_LENGTH'});\r
151 \r
152                 binmode(STDIN);\r
153                 # STDIN A pause character is detected.'(MacIE3.0 boundary of $ENV{'CONTENT_TYPE'} cannot be trusted.)\r
154                 my $Boundary = <STDIN>;\r
155                 $Boundary =~ s/\x0D\x0A//;\r
156                 $Boundary = quotemeta($Boundary);\r
157                 while(<STDIN>) {\r
158                         if(/^\s*Content-Disposition:/i) {\r
159                                 my($name,$ContentType,$FileName);\r
160                                 # form data get\r
161                                 if(/\bname="([^"]+)"/i || /\bname=([^\s:;]+)/i) {\r
162                                         $name = $1;\r
163                                         $name   =~ tr/+/ /;\r
164                                         $name   =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;\r
165                                         &Encode(\$name);\r
166                                 }\r
167                                 if(/\bfilename="([^"]*)"/i || /\bfilename=([^\s:;]*)/i) {\r
168                                         $FileName = $1 || 'unknown';\r
169                                 }\r
170                                 # head read\r
171                                 while(<STDIN>) {\r
172                                         last    if(! /\w/);\r
173                                         if(/^\s*Content-Type:\s*"([^"]+)"/i || /^\s*Content-Type:\s*([^\s:;]+)/i) {\r
174                                                 $ContentType = $1;\r
175                                         }\r
176                                 }\r
177                                 # body read\r
178                                 $value = "";\r
179                                 while(<STDIN>) {\r
180                                         last    if(/^$Boundary/o);\r
181                                         $value .= $_;\r
182                                 };\r
183                                 $lastline = $_;\r
184                                 $value =~s /\x0D\x0A$//;\r
185                                 if($value ne '') {\r
186                                         if($FileName || $ContentType) {\r
187                                                 $img_data_exists = 1;\r
188                                                 (\r
189                                                         $FileName,              #\r
190                                                         $Ext,                   #\r
191                                                         $Length,                #\r
192                                                         $ImageWidth,    #\r
193                                                         $ImageHeight,   #\r
194                                                         $ContentName    #\r
195                                                 ) = &CheckContentType(\$value,$FileName,$ContentType);\r
196 \r
197                                                 $FORM{$name}    = $FileName;\r
198                                                 $new_fname              = $FileName;\r
199                                                 push(@NEWFNAME_DATA,"$FileName\t$Ext\t$Length\t$ImageWidth\t$ImageHeight\t$ContentName");\r
200 \r
201                                                 # Multi-upload correspondence\r
202                                                 push(@NEWFNAMES,$new_fname);\r
203                                                 open(OUT,">$img_dir/$new_fname");\r
204                                                 binmode(OUT);\r
205                                                 eval "flock(OUT,2);" if($PM{'flock'} == 1);\r
206                                                 print OUT $value;\r
207                                                 eval "flock(OUT,8);" if($PM{'flock'} == 1);\r
208                                                 close(OUT);\r
209 \r
210                                         } elsif($name) {\r
211                                                 $value  =~ tr/+/ /;\r
212                                                 $value  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;\r
213                                                 &Encode(\$value,'trans');\r
214                                                 $FORM{$name} .= "\0"                    if(defined($FORM{$name}));\r
215                                                 $FORM{$name} .= $value;\r
216                                         }\r
217                                 }\r
218                         };\r
219                         last if($lastline =~ /^$Boundary\-\-/o);\r
220                 }\r
221         } elsif($ENV{'CONTENT_LENGTH'}) {\r
222                 read(STDIN,$Buffer,$ENV{'CONTENT_LENGTH'});\r
223         }\r
224         foreach(split(/&/,$Buffer),split(/&/,$ENV{'QUERY_STRING'})) {\r
225                 my($name, $value) = split(/=/);\r
226                 $name   =~ tr/+/ /;\r
227                 $name   =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;\r
228                 $value  =~ tr/+/ /;\r
229                 $value  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;\r
230 \r
231                 &Encode(\$name);\r
232                 &Encode(\$value,'trans');\r
233                 $FORM{$name} .= "\0"                    if(defined($FORM{$name}));\r
234                 $FORM{$name} .= $value;\r
235 \r
236         }\r
237 \r
238 }\r
239 \r
240 ##############################################################################\r
241 # Summary\r
242 #\r
243 #       CheckContentType\r
244 #\r
245 # Parameters\r
246 # Returns\r
247 # Memo\r
248 ##############################################################################\r
249 sub CheckContentType\r
250 {\r
251 \r
252         my($DATA,$FileName,$ContentType) = @_;\r
253         my($Ext,$ImageWidth,$ImageHeight,$ContentName,$Infomation);\r
254         my $DataLength = length($$DATA);\r
255 \r
256         # An unknown file type\r
257 \r
258         $_ = $ContentType;\r
259         my $UnknownType = (\r
260                 !$_\r
261                 || /^application\/(x-)?macbinary$/i\r
262                 || /^application\/applefile$/i\r
263                 || /^application\/octet-stream$/i\r
264                 || /^text\/plane$/i\r
265                 || /^x-unknown-content-type/i\r
266         );\r
267 \r
268         # MacBinary(Mac Unnecessary data are deleted.)\r
269         if($UnknownType || $ENV{'HTTP_USER_AGENT'} =~ /Macintosh|Mac_/) {\r
270                 if($DataLength > 128 && !unpack("C",substr($$DATA,0,1)) && !unpack("C",substr($$DATA,74,1)) && !unpack("C",substr($$DATA,82,1)) ) {\r
271                         my $MacBinary_ForkLength = unpack("N", substr($$DATA, 83, 4));          # ForkLength Get\r
272                         my $MacBinary_FileName = quotemeta(substr($$DATA, 2, unpack("C",substr($$DATA, 1, 1))));\r
273                         if($MacBinary_FileName && $MacBinary_ForkLength && $DataLength >= $MacBinary_ForkLength + 128\r
274                                         && ($FileName =~ /$MacBinary_FileName/i || substr($$DATA,102,4) eq 'mBIN')) {   # DATA TOP 128byte MacBinary!!\r
275                                 $$DATA                          = substr($$DATA,128,$MacBinary_ForkLength);\r
276                                 my $ResourceLength      = $DataLength - $MacBinary_ForkLength - 128;\r
277                                 $DataLength                     = $MacBinary_ForkLength;\r
278                         }\r
279                 }\r
280         }\r
281 \r
282         # A file name is changed into EUC.\r
283 #       &jcode::convert(\$FileName,'euc',$FormCodeDefault);\r
284 #       &jcode::h2z_euc(\$FileName);\r
285         $FileName =~ s/^.*\\//;                                 # Windows, Mac\r
286         $FileName =~ s/^.*\///;                                 # UNIX\r
287         $FileName =~ s/&/&amp;/g;\r
288         $FileName =~ s/"/&quot;/g;\r
289         $FileName =~ s/</&lt;/g;\r
290         $FileName =~ s/>/&gt;/g;\r
291 #\r
292 #       if($CHARCODE ne 'euc') {\r
293 #               &jcode::convert(\$FileName,$CHARCODE,'euc');\r
294 #       }\r
295 \r
296         # An extension is extracted and it changes into a small letter.\r
297         my $FileExt;\r
298         if($FileName =~ /\.(\w+)$/) {\r
299                 $FileExt = $1;\r
300                 $FileExt =~ tr/A-Z/a-z/;\r
301         }\r
302 \r
303         # Executable file detection (ban on upload)\r
304         if($$DATA =~ /^MZ/) {\r
305                 $Ext = 'exe';\r
306         }\r
307         # text\r
308         if(!$Ext && ($UnknownType || $ContentType =~ /^text\//i || $ContentType =~ /^application\/(?:rtf|richtext)$/i || $ContentType =~ /^image\/x-xbitmap$/i)\r
309                                 && ! $$DATA =~ /[\000-\006\177\377]/) {\r
310 #               $$DATA =~ s/\x0D\x0A/\n/g;\r
311 #               $$DATA =~ tr/\x0D\x0A/\n\n/;\r
312 #\r
313 #               if(\r
314 #                       $$DATA =~ /<\s*SCRIPT(?:.|\n)*?>/i\r
315 #                               || $$DATA =~ /<\s*(?:.|\n)*?\bONLOAD\s*=(?:.|\n)*?>/i\r
316 #                               || $$DATA =~ /<\s*(?:.|\n)*?\bONCLICK\s*=(?:.|\n)*?>/i\r
317 #                               ) {\r
318 #                       $Infomation = '(JavaScript contains)';\r
319 #               }\r
320 #               if($$DATA =~ /<\s*TABLE(?:.|\n)*?>/i\r
321 #                               || $$DATA =~ /<\s*BLINK(?:.|\n)*?>/i\r
322 #                               || $$DATA =~ /<\s*MARQUEE(?:.|\n)*?>/i\r
323 #                               || $$DATA =~ /<\s*OBJECT(?:.|\n)*?>/i\r
324 #                               || $$DATA =~ /<\s*EMBED(?:.|\n)*?>/i\r
325 #                               || $$DATA =~ /<\s*FRAME(?:.|\n)*?>/i\r
326 #                               || $$DATA =~ /<\s*APPLET(?:.|\n)*?>/i\r
327 #                               || $$DATA =~ /<\s*FORM(?:.|\n)*?>/i\r
328 #                               || $$DATA =~ /<\s*(?:.|\n)*?\bSRC\s*=(?:.|\n)*?>/i\r
329 #                               || $$DATA =~ /<\s*(?:.|\n)*?\bDYNSRC\s*=(?:.|\n)*?>/i\r
330 #                               ) {\r
331 #                       $Infomation = '(the HTML tag which is not safe is included)';\r
332 #               }\r
333 \r
334                 if($FileExt =~ /^txt$/i || $FileExt =~ /^cgi$/i || $FileExt =~ /^pl$/i) {                                                               # Text File\r
335                         $Ext = 'txt';\r
336                 } elsif($ContentType =~ /^text\/html$/i || $FileExt =~ /html?/i || $$DATA =~ /<\s*HTML(?:.|\n)*?>/i) {  # HTML File\r
337                         $Ext = 'html';\r
338                 } elsif($ContentType =~ /^image\/x-xbitmap$/i || $FileExt =~ /^xbm$/i) {                                                                # XBM(x-BitMap) Image\r
339                         my $XbmName = $1;\r
340                         my ($XbmWidth, $XbmHeight);\r
341                         if($$DATA =~ /\#define\s*$XbmName\_width\s*(\d+)/i) {\r
342                                 $XbmWidth = $1;\r
343                         }\r
344                         if($$DATA =~ /\#define\s*$XbmName\_height\s*(\d+)/i) {\r
345                                 $XbmHeight = $1;\r
346                         }\r
347                         if($XbmWidth && $XbmHeight) {\r
348                                 $Ext = 'xbm';\r
349                                 $ImageWidth             = $XbmWidth;\r
350                                 $ImageHeight    = $XbmHeight;\r
351                         }\r
352                 } else {                #\r
353                         $Ext = 'txt';\r
354                 }\r
355         }\r
356 \r
357         # image\r
358         if(!$Ext && ($UnknownType || $ContentType =~ /^image\//i)) {\r
359                 # PNG\r
360                 if($$DATA =~ /^\x89PNG\x0D\x0A\x1A\x0A/) {\r
361                         if(substr($$DATA, 12, 4) eq 'IHDR') {\r
362                                 $Ext = 'png';\r
363                                 ($ImageWidth, $ImageHeight) = unpack("N2", substr($$DATA, 16, 8));\r
364                         }\r
365                 } elsif($$DATA =~ /^GIF8(?:9|7)a/) {                                                                                                                    # GIF89a(modified), GIF89a, GIF87a\r
366                         $Ext = 'gif';\r
367                         ($ImageWidth, $ImageHeight) = unpack("v2", substr($$DATA, 6, 4));\r
368                 } elsif($$DATA =~ /^II\x2a\x00\x08\x00\x00\x00/ || $$DATA =~ /^MM\x00\x2a\x00\x00\x00\x08/) {   # TIFF\r
369                         $Ext = 'tif';\r
370                 } elsif($$DATA =~ /^BM/) {                                                                                                                                              # BMP\r
371                         $Ext = 'bmp';\r
372                 } elsif($$DATA =~ /^\xFF\xD8\xFF/ || $$DATA =~ /JFIF/) {                                                                                # JPEG\r
373                         my $HeaderPoint = index($$DATA, "\xFF\xD8\xFF", 0);\r
374                         my $Point = $HeaderPoint + 2;\r
375                         while($Point < $DataLength) {\r
376                                 my($Maker, $MakerType, $MakerLength) = unpack("C2n",substr($$DATA,$Point,4));\r
377                                 if($Maker != 0xFF || $MakerType == 0xd9 || $MakerType == 0xda) {\r
378                                         last;\r
379                                 } elsif($MakerType >= 0xC0 && $MakerType <= 0xC3) {\r
380                                         $Ext = 'jpg';\r
381                                         ($ImageHeight, $ImageWidth) = unpack("n2", substr($$DATA, $Point + 5, 4));\r
382                                         if($HeaderPoint > 0) {\r
383                                                 $$DATA = substr($$DATA, $HeaderPoint);\r
384                                                 $DataLength = length($$DATA);\r
385                                         }\r
386                                         last;\r
387                                 } else {\r
388                                         $Point += $MakerLength + 2;\r
389                                 }\r
390                         }\r
391                 }\r
392         }\r
393 \r
394         # audio\r
395         if(!$Ext && ($UnknownType || $ContentType =~ /^audio\//i)) {\r
396                 # MIDI Audio\r
397                 if($$DATA =~ /^MThd/) {\r
398                         $Ext = 'mid';\r
399                 } elsif($$DATA =~ /^\x2esnd/) {         # ULAW Audio\r
400                         $Ext = 'au';\r
401                 } elsif($$DATA =~ /^RIFF/ || $$DATA =~ /^ID3/ && $$DATA =~ /RIFF/) {\r
402                         my $HeaderPoint = index($$DATA, "RIFF", 0);\r
403                         $_ = substr($$DATA, $HeaderPoint + 8, 8);\r
404                         if(/^WAVEfmt $/) {\r
405                                 # WAVE\r
406                                 if(unpack("V",substr($$DATA, $HeaderPoint + 16, 4)) == 16) {\r
407                                         $Ext = 'wav';\r
408                                 } else {                                        # RIFF WAVE MP3\r
409                                         $Ext = 'mp3';\r
410                                 }\r
411                         } elsif(/^RMIDdata$/) {                 # RIFF MIDI\r
412                                 $Ext = 'rmi';\r
413                         } elsif(/^RMP3data$/) {                 # RIFF MP3\r
414                                 $Ext = 'rmp';\r
415                         }\r
416                         if($ContentType =~ /^audio\//i) {\r
417                                 $Infomation .= '(RIFF '. substr($$DATA, $HeaderPoint + 8, 4). ')';\r
418                         }\r
419                 }\r
420         }\r
421 \r
422         # a binary file\r
423         unless ($Ext) {\r
424                 # PDF image\r
425                 if($$DATA =~ /^\%PDF/) {\r
426                         # Picture size is not measured.\r
427                         $Ext = 'pdf';\r
428                 } elsif($$DATA =~ /^FWS/) {             # Shockwave Flash\r
429                         $Ext = 'swf';\r
430                 } elsif($$DATA =~ /^RIFF/ || $$DATA =~ /^ID3/ && $$DATA =~ /RIFF/) {\r
431                         my $HeaderPoint = index($$DATA, "RIFF", 0);\r
432                         $_ = substr($$DATA,$HeaderPoint + 8, 8);\r
433                         # AVI\r
434                         if(/^AVI LIST$/) {\r
435                                 $Ext = 'avi';\r
436                         }\r
437                         if($ContentType =~ /^video\//i) {\r
438                                 $Infomation .= '(RIFF '. substr($$DATA, $HeaderPoint + 8, 4). ')';\r
439                         }\r
440                 } elsif($$DATA =~ /^PK/) {                      # ZIP Compress File\r
441                         $Ext = 'zip';\r
442                 } elsif($$DATA =~ /^MSCF/) {            # CAB Compress File\r
443                         $Ext = 'cab';\r
444                 } elsif($$DATA =~ /^Rar\!/) {           # RAR Compress File\r
445                         $Ext = 'rar';\r
446                 } elsif(substr($$DATA, 2, 5) =~ /^\-lh(\d+|d)\-$/) {            # LHA Compress File\r
447                         $Infomation .= "(lh$1)";\r
448                         $Ext = 'lzh';\r
449                 } elsif(substr($$DATA, 325, 25) eq "Apple Video Media Handler" || substr($$DATA, 325, 30) eq "Apple \x83\x72\x83\x66\x83\x49\x81\x45\x83\x81\x83\x66\x83\x42\x83\x41\x83\x6E\x83\x93\x83\x68\x83\x89") {\r
450                         # QuickTime\r
451                         $Ext = 'mov';\r
452                 }\r
453         }\r
454 \r
455         # Header analysis failure\r
456         unless ($Ext) {\r
457                 # It will be followed if it applies for the MIME type from the browser.\r
458                 foreach (keys %UPLOAD_CONTENT_TYPE_LIST) {\r
459                         next unless ($_);\r
460                         if($ContentType =~ /^$_$/i) {\r
461                                 $Ext = $UPLOAD_CONTENT_TYPE_LIST{$_};\r
462                                 $ContentName = &CheckContentExt($Ext);\r
463                                 if(\r
464                                         grep {$_ eq $Ext;} (\r
465                                                 'png',\r
466                                                 'gif',\r
467                                                 'jpg',\r
468                                                 'xbm',\r
469                                                 'tif',\r
470                                                 'bmp',\r
471                                                 'pdf',\r
472                                                 'swf',\r
473                                                 'mov',\r
474                                                 'zip',\r
475                                                 'cab',\r
476                                                 'lzh',\r
477                                                 'rar',\r
478                                                 'mid',\r
479                                                 'rmi',\r
480                                                 'au',\r
481                                                 'wav',\r
482                                                 'avi',\r
483                                                 'exe'\r
484                                         )\r
485                                 ) {\r
486                                         $Infomation .= ' / Header analysis failure';\r
487                                 }\r
488                                 if($Ext ne $FileExt && &CheckContentExt($FileExt) eq $ContentName) {\r
489                                         $Ext = $FileExt;\r
490                                 }\r
491                                 last;\r
492                         }\r
493                 }\r
494                 # a MIME type is unknown--It judges from an extension.\r
495                 unless ($Ext) {\r
496                         $ContentName = &CheckContentExt($FileExt);\r
497                         if($ContentName) {\r
498                                 $Ext = $FileExt;\r
499                                 $Infomation .= ' /      MIME type is unknown('. $ContentType. ')';\r
500                                 last;\r
501                         }\r
502                 }\r
503         }\r
504 \r
505 #       $ContentName = &CheckContentExt($Ext)   unless($ContentName);\r
506 #       if($Ext && $ContentName) {\r
507 #               $ContentName .=  $Infomation;\r
508 #       } else {\r
509 #               &upload_error(\r
510 #                       'Extension Error',\r
511 #                       "$FileName A not corresponding extension ($Ext)<BR>The extension which can be responded ". join(',', sort values(%UPLOAD_EXT_LIST))\r
512 #               );\r
513 #       }\r
514 \r
515 #       # SSI Tag Deletion\r
516 #       if($Ext =~ /.?html?/ && $$DATA =~ /<\!/) {\r
517 #               foreach (\r
518 #                       'config',\r
519 #                       'echo',\r
520 #                       'exec',\r
521 #                       'flastmod',\r
522 #                       'fsize',\r
523 #                       'include'\r
524 #               ) {\r
525 #                       $$DATA =~ s/\#\s*$_/\&\#35\;$_/ig\r
526 #               }\r
527 #       }\r
528 \r
529         return (\r
530                 $FileName,\r
531                 $Ext,\r
532                 int($DataLength / 1024 + 1),\r
533                 $ImageWidth,\r
534                 $ImageHeight,\r
535                 $ContentName\r
536         );\r
537 }\r
538 \r
539 ##############################################################################\r
540 # Summary\r
541 #\r
542 # Extension discernment\r
543 #\r
544 # Parameters\r
545 # Returns\r
546 # Memo\r
547 ##############################################################################\r
548 \r
549 sub CheckContentExt\r
550 {\r
551 \r
552         my($Ext) = @_;\r
553         my $ContentName;\r
554         foreach (keys %UPLOAD_EXT_LIST) {\r
555                 next    unless ($_);\r
556                 if($_ && $Ext =~ /^$_$/) {\r
557                         $ContentName = $UPLOAD_EXT_LIST{$_};\r
558                         last;\r
559                 }\r
560         }\r
561         return $ContentName;\r
562 \r
563 }\r
564 \r
565 ##############################################################################\r
566 # Summary\r
567 #\r
568 # Form decode\r
569 #\r
570 # Parameters\r
571 # Returns\r
572 # Memo\r
573 ##############################################################################\r
574 sub Encode\r
575 {\r
576 \r
577         my($value,$Trans) = @_;\r
578 \r
579 #       my $FormCode = &jcode::getcode($value) || $FormCodeDefault;\r
580 #       $FormCodeDefault ||= $FormCode;\r
581 #\r
582 #       if($Trans && $TRANS_2BYTE_CODE) {\r
583 #               if($FormCode ne 'euc') {\r
584 #                       &jcode::convert($value, 'euc', $FormCode);\r
585 #               }\r
586 #               &jcode::tr(\r
587 #                       $value,\r
588 #                       "\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA",\r
589 #                       '0-9A-Za-z'\r
590 #               );\r
591 #               if($CHARCODE ne 'euc') {\r
592 #                       &jcode::convert($value,$CHARCODE,'euc');\r
593 #               }\r
594 #       } else {\r
595 #               if($CHARCODE ne $FormCode) {\r
596 #                       &jcode::convert($value,$CHARCODE,$FormCode);\r
597 #               }\r
598 #       }\r
599 #       if($CHARCODE eq 'euc') {\r
600 #               &jcode::h2z_euc($value);\r
601 #       } elsif($CHARCODE eq 'sjis') {\r
602 #               &jcode::h2z_sjis($value);\r
603 #       }\r
604 \r
605 }\r
606 \r
607 ##############################################################################\r
608 # Summary\r
609 #\r
610 # Error Msg\r
611 #\r
612 # Parameters\r
613 # Returns\r
614 # Memo\r
615 ##############################################################################\r
616 \r
617 sub upload_error\r
618 {\r
619 \r
620         local($error_message)   = $_[0];\r
621         local($error_message2)  = $_[1];\r
622 \r
623         print "Content-type: text/html\n\n";\r
624         print<<EOF;\r
625 <HTML>\r
626 <HEAD>\r
627 <TITLE>Error Message</TITLE></HEAD>\r
628 <BODY>\r
629 <table border="1" cellspacing="10" cellpadding="10">\r
630         <TR bgcolor="#0000B0">\r
631         <TD bgcolor="#0000B0" NOWRAP><font size="-1" color="white"><B>Error Message</B></font></TD>\r
632         </TR>\r
633 </table>\r
634 <UL>\r
635 <H4> $error_message </H4>\r
636 $error_message2 <BR>\r
637 </UL>\r
638 </BODY>\r
639 </HTML>\r
640 EOF\r
641         &rm_tmp_uploaded_files;                 # Image Temporary deletion\r
642         exit;\r
643 }\r
644 \r
645 ##############################################################################\r
646 # Summary\r
647 #\r
648 # Image Temporary deletion\r
649 #\r
650 # Parameters\r
651 # Returns\r
652 # Memo\r
653 ##############################################################################\r
654 \r
655 sub rm_tmp_uploaded_files\r
656 {\r
657         if($img_data_exists == 1){\r
658                 sleep 1;\r
659                 foreach $fname_list(@NEWFNAMES) {\r
660                         if(-e "$img_dir/$fname_list") {\r
661                                 unlink("$img_dir/$fname_list");\r
662                         }\r
663                 }\r
664         }\r
665 \r
666 }\r
667 1;\r