2 # FCKeditor - The text editor for Internet - http://www.fckeditor.net
\r
3 # Copyright (C) 2003-2010 Frederico Caldeira Knabben
\r
5 # == BEGIN LICENSE ==
\r
7 # Licensed under the terms of any of the following licenses at your
\r
10 # - GNU General Public License Version 2 or later (the "GPL")
\r
11 # http://www.gnu.org/licenses/gpl.html
\r
13 # - GNU Lesser General Public License Version 2.1 or later (the "LGPL")
\r
14 # http://www.gnu.org/licenses/lgpl.html
\r
16 # - Mozilla Public License Version 1.1 or later (the "MPL")
\r
17 # http://www.mozilla.org/MPL/MPL-1.1.html
\r
21 # This is the File Manager Connector for Perl.
\r
24 # image data save dir
\r
25 $img_dir = './temp/';
\r
28 # File size max(unit KB)
\r
29 $MAX_CONTENT_SIZE = 30000;
\r
31 # After file is uploaded, sometimes it is required to change its permissions
\r
32 # so that it was possible to access it at the later time.
\r
33 # If possible, it is recommended to set more restrictive permissions, like 0755.
\r
34 # Set to 0 to disable this feature.
\r
35 $CHMOD_ON_UPLOAD = 0777;
\r
37 # See comments above.
\r
38 # Used when creating folders that does not exist.
\r
39 $CHMOD_ON_FOLDER_CREATE = 0755;
\r
41 # Filelock (1=use,0=not use)
\r
45 # upload Content-Type list
\r
46 my %UPLOAD_CONTENT_TYPE_LIST = (
\r
47 'image/(x-)?png' => 'png', # PNG image
\r
48 'image/p?jpe?g' => 'jpg', # JPEG image
\r
49 'image/gif' => 'gif', # GIF image
\r
50 'image/x-xbitmap' => 'xbm', # XBM image
\r
52 'image/(x-(MS-)?)?bmp' => 'bmp', # Windows BMP image
\r
53 'image/pict' => 'pict', # Macintosh PICT image
\r
54 'image/tiff' => 'tif', # TIFF image
\r
55 'application/pdf' => 'pdf', # PDF image
\r
56 'application/x-shockwave-flash' => 'swf', # Shockwave Flash
\r
58 'video/(x-)?msvideo' => 'avi', # Microsoft Video
\r
59 'video/quicktime' => 'mov', # QuickTime Video
\r
60 'video/mpeg' => 'mpeg', # MPEG Video
\r
61 'video/x-mpeg2' => 'mpv2', # MPEG2 Video
\r
63 'audio/(x-)?midi?' => 'mid', # MIDI Audio
\r
64 'audio/(x-)?wav' => 'wav', # WAV Audio
\r
65 'audio/basic' => 'au', # ULAW Audio
\r
66 'audio/mpeg' => 'mpga', # MPEG Audio
\r
68 'application/(x-)?zip(-compressed)?' => 'zip', # ZIP Compress
\r
70 'text/html' => 'html', # HTML
\r
71 'text/plain' => 'txt', # TEXT
\r
72 '(?:application|text)/(?:rtf|richtext)' => 'rtf', # RichText
\r
74 'application/msword' => 'doc', # Microsoft Word
\r
75 'application/vnd.ms-excel' => 'xls', # Microsoft Excel
\r
80 # Upload is permitted.
\r
81 # A regular expression is possible.
\r
82 my %UPLOAD_EXT_LIST = (
\r
83 'png' => 'PNG image',
\r
84 'p?jpe?g|jpe|jfif|pjp' => 'JPEG image',
\r
85 'gif' => 'GIF image',
\r
86 'xbm' => 'XBM image',
\r
88 'bmp|dib|rle' => 'Windows BMP image',
\r
89 'pi?ct' => 'Macintosh PICT image',
\r
90 'tiff?' => 'TIFF image',
\r
91 'pdf' => 'PDF image',
\r
92 'swf' => 'Shockwave Flash',
\r
94 'avi' => 'Microsoft Video',
\r
95 'moo?v|qt' => 'QuickTime Video',
\r
96 'm(p(e?gv?|e|v)|1v)' => 'MPEG Video',
\r
97 'mp(v2|2v)' => 'MPEG2 Video',
\r
99 'midi?|kar|smf|rmi|mff' => 'MIDI Audio',
\r
100 'wav' => 'WAVE Audio',
\r
101 'au|snd' => 'ULAW Audio',
\r
102 'mp(e?ga|2|a|3)|abs' => 'MPEG Audio',
\r
104 'zip' => 'ZIP Compress',
\r
105 'lzh' => 'LZH Compress',
\r
106 'cab' => 'CAB Compress',
\r
108 'd?html?' => 'HTML',
\r
109 'rtf|rtx' => 'RichText',
\r
110 'txt|text' => 'Text',
\r
117 my $CHARCODE = 'sjis';
\r
119 $TRANS_2BYTE_CODE = 0;
\r
121 ##############################################################################
\r
129 ##############################################################################
\r
132 eval("use File::Copy;");
\r
133 eval("use File::Path;");
\r
137 if (defined $CHMOD_ON_FOLDER_CREATE && !$CHMOD_ON_FOLDER_CREATE) {
\r
142 if (defined $CHMOD_ON_FOLDER_CREATE) {
\r
143 mkdir("$img_dir",$CHMOD_ON_FOLDER_CREATE);
\r
146 mkdir("$img_dir",0777);
\r
150 undef $img_data_exists;
\r
152 undef @NEWFNAME_DATA;
\r
154 if($ENV{'CONTENT_LENGTH'} > 10000000 || $ENV{'CONTENT_LENGTH'} > $MAX_CONTENT_SIZE * 1024) {
\r
158 "Transmitting size is too large.MAX <strong>%d KB</strong> Now Size <strong>%d KB</strong>(<strong>%d bytes</strong> Over)",
\r
160 int($ENV{'CONTENT_LENGTH'} / 1024),
\r
161 $ENV{'CONTENT_LENGTH'} - $MAX_CONTENT_SIZE * 1024
\r
167 if($ENV{'CONTENT_TYPE'} =~ /multipart\/form-data/) {
\r
169 return unless($ENV{'CONTENT_LENGTH'});
\r
172 # STDIN A pause character is detected.'(MacIE3.0 boundary of $ENV{'CONTENT_TYPE'} cannot be trusted.)
\r
173 my $Boundary = <STDIN>;
\r
174 $Boundary =~ s/\x0D\x0A//;
\r
175 $Boundary = quotemeta($Boundary);
\r
177 if(/^\s*Content-Disposition:/i) {
\r
178 my($name,$ContentType,$FileName);
\r
180 if(/\bname="([^"]+)"/i || /\bname=([^\s:;]+)/i) {
\r
183 $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
\r
186 if(/\bfilename="([^"]*)"/i || /\bfilename=([^\s:;]*)/i) {
\r
187 $FileName = $1 || 'unknown';
\r
192 if(/^\s*Content-Type:\s*"([^"]+)"/i || /^\s*Content-Type:\s*([^\s:;]+)/i) {
\r
199 last if(/^$Boundary/o);
\r
203 $value =~s /\x0D\x0A$//;
\r
205 if($FileName || $ContentType) {
\r
206 $img_data_exists = 1;
\r
214 ) = &CheckContentType(\$value,$FileName,$ContentType);
\r
216 $FORM{$name} = $FileName;
\r
217 $new_fname = $FileName;
\r
218 push(@NEWFNAME_DATA,"$FileName\t$Ext\t$Length\t$ImageWidth\t$ImageHeight\t$ContentName");
\r
220 # Multi-upload correspondence
\r
221 push(@NEWFNAMES,$new_fname);
\r
222 open(OUT,">$img_dir/$new_fname");
\r
224 eval "flock(OUT,2);" if($PM{'flock'} == 1);
\r
226 eval "flock(OUT,8);" if($PM{'flock'} == 1);
\r
231 $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
\r
232 &Encode(\$value,'trans');
\r
233 $FORM{$name} .= "\0" if(defined($FORM{$name}));
\r
234 $FORM{$name} .= $value;
\r
238 last if($lastline =~ /^$Boundary\-\-/o);
\r
240 } elsif($ENV{'CONTENT_LENGTH'}) {
\r
241 read(STDIN,$Buffer,$ENV{'CONTENT_LENGTH'});
\r
243 foreach(split(/&/,$Buffer),split(/&/,$ENV{'QUERY_STRING'})) {
\r
244 my($name, $value) = split(/=/);
\r
246 $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
\r
248 $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
\r
251 &Encode(\$value,'trans');
\r
252 $FORM{$name} .= "\0" if(defined($FORM{$name}));
\r
253 $FORM{$name} .= $value;
\r
259 ##############################################################################
\r
267 ##############################################################################
\r
268 sub CheckContentType
\r
271 my($DATA,$FileName,$ContentType) = @_;
\r
272 my($Ext,$ImageWidth,$ImageHeight,$ContentName,$Infomation);
\r
273 my $DataLength = length($$DATA);
\r
275 # An unknown file type
\r
278 my $UnknownType = (
\r
280 || /^application\/(x-)?macbinary$/i
\r
281 || /^application\/applefile$/i
\r
282 || /^application\/octet-stream$/i
\r
283 || /^text\/plane$/i
\r
284 || /^x-unknown-content-type/i
\r
287 # MacBinary(Mac Unnecessary data are deleted.)
\r
288 if($UnknownType || $ENV{'HTTP_USER_AGENT'} =~ /Macintosh|Mac_/) {
\r
289 if($DataLength > 128 && !unpack("C",substr($$DATA,0,1)) && !unpack("C",substr($$DATA,74,1)) && !unpack("C",substr($$DATA,82,1)) ) {
\r
290 my $MacBinary_ForkLength = unpack("N", substr($$DATA, 83, 4)); # ForkLength Get
\r
291 my $MacBinary_FileName = quotemeta(substr($$DATA, 2, unpack("C",substr($$DATA, 1, 1))));
\r
292 if($MacBinary_FileName && $MacBinary_ForkLength && $DataLength >= $MacBinary_ForkLength + 128
\r
293 && ($FileName =~ /$MacBinary_FileName/i || substr($$DATA,102,4) eq 'mBIN')) { # DATA TOP 128byte MacBinary!!
\r
294 $$DATA = substr($$DATA,128,$MacBinary_ForkLength);
\r
295 my $ResourceLength = $DataLength - $MacBinary_ForkLength - 128;
\r
296 $DataLength = $MacBinary_ForkLength;
\r
301 # A file name is changed into EUC.
\r
302 # &jcode::convert(\$FileName,'euc',$FormCodeDefault);
\r
303 # &jcode::h2z_euc(\$FileName);
\r
304 $FileName =~ s/^.*\\//; # Windows, Mac
\r
305 $FileName =~ s/^.*\///; # UNIX
\r
306 $FileName =~ s/&/&/g;
\r
307 $FileName =~ s/"/"/g;
\r
308 $FileName =~ s/</</g;
\r
309 $FileName =~ s/>/>/g;
\r
311 # if($CHARCODE ne 'euc') {
\r
312 # &jcode::convert(\$FileName,$CHARCODE,'euc');
\r
315 # An extension is extracted and it changes into a small letter.
\r
317 if($FileName =~ /\.(\w+)$/) {
\r
319 $FileExt =~ tr/A-Z/a-z/;
\r
322 # Executable file detection (ban on upload)
\r
323 if($$DATA =~ /^MZ/) {
\r
327 if(!$Ext && ($UnknownType || $ContentType =~ /^text\//i || $ContentType =~ /^application\/(?:rtf|richtext)$/i || $ContentType =~ /^image\/x-xbitmap$/i)
\r
328 && ! $$DATA =~ /[\000-\006\177\377]/) {
\r
329 # $$DATA =~ s/\x0D\x0A/\n/g;
\r
330 # $$DATA =~ tr/\x0D\x0A/\n\n/;
\r
333 # $$DATA =~ /<\s*SCRIPT(?:.|\n)*?>/i
\r
334 # || $$DATA =~ /<\s*(?:.|\n)*?\bONLOAD\s*=(?:.|\n)*?>/i
\r
335 # || $$DATA =~ /<\s*(?:.|\n)*?\bONCLICK\s*=(?:.|\n)*?>/i
\r
337 # $Infomation = '(JavaScript contains)';
\r
339 # if($$DATA =~ /<\s*TABLE(?:.|\n)*?>/i
\r
340 # || $$DATA =~ /<\s*BLINK(?:.|\n)*?>/i
\r
341 # || $$DATA =~ /<\s*MARQUEE(?:.|\n)*?>/i
\r
342 # || $$DATA =~ /<\s*OBJECT(?:.|\n)*?>/i
\r
343 # || $$DATA =~ /<\s*EMBED(?:.|\n)*?>/i
\r
344 # || $$DATA =~ /<\s*FRAME(?:.|\n)*?>/i
\r
345 # || $$DATA =~ /<\s*APPLET(?:.|\n)*?>/i
\r
346 # || $$DATA =~ /<\s*FORM(?:.|\n)*?>/i
\r
347 # || $$DATA =~ /<\s*(?:.|\n)*?\bSRC\s*=(?:.|\n)*?>/i
\r
348 # || $$DATA =~ /<\s*(?:.|\n)*?\bDYNSRC\s*=(?:.|\n)*?>/i
\r
350 # $Infomation = '(the HTML tag which is not safe is included)';
\r
353 if($FileExt =~ /^txt$/i || $FileExt =~ /^cgi$/i || $FileExt =~ /^pl$/i) { # Text File
\r
355 } elsif($ContentType =~ /^text\/html$/i || $FileExt =~ /html?/i || $$DATA =~ /<\s*HTML(?:.|\n)*?>/i) { # HTML File
\r
357 } elsif($ContentType =~ /^image\/x-xbitmap$/i || $FileExt =~ /^xbm$/i) { # XBM(x-BitMap) Image
\r
359 my ($XbmWidth, $XbmHeight);
\r
360 if($$DATA =~ /\#define\s*$XbmName\_width\s*(\d+)/i) {
\r
363 if($$DATA =~ /\#define\s*$XbmName\_height\s*(\d+)/i) {
\r
366 if($XbmWidth && $XbmHeight) {
\r
368 $ImageWidth = $XbmWidth;
\r
369 $ImageHeight = $XbmHeight;
\r
377 if(!$Ext && ($UnknownType || $ContentType =~ /^image\//i)) {
\r
379 if($$DATA =~ /^\x89PNG\x0D\x0A\x1A\x0A/) {
\r
380 if(substr($$DATA, 12, 4) eq 'IHDR') {
\r
382 ($ImageWidth, $ImageHeight) = unpack("N2", substr($$DATA, 16, 8));
\r
384 } elsif($$DATA =~ /^GIF8(?:9|7)a/) { # GIF89a(modified), GIF89a, GIF87a
\r
386 ($ImageWidth, $ImageHeight) = unpack("v2", substr($$DATA, 6, 4));
\r
387 } elsif($$DATA =~ /^II\x2a\x00\x08\x00\x00\x00/ || $$DATA =~ /^MM\x00\x2a\x00\x00\x00\x08/) { # TIFF
\r
389 } elsif($$DATA =~ /^BM/) { # BMP
\r
391 } elsif($$DATA =~ /^\xFF\xD8\xFF/ || $$DATA =~ /JFIF/) { # JPEG
\r
392 my $HeaderPoint = index($$DATA, "\xFF\xD8\xFF", 0);
\r
393 my $Point = $HeaderPoint + 2;
\r
394 while($Point < $DataLength) {
\r
395 my($Maker, $MakerType, $MakerLength) = unpack("C2n",substr($$DATA,$Point,4));
\r
396 if($Maker != 0xFF || $MakerType == 0xd9 || $MakerType == 0xda) {
\r
398 } elsif($MakerType >= 0xC0 && $MakerType <= 0xC3) {
\r
400 ($ImageHeight, $ImageWidth) = unpack("n2", substr($$DATA, $Point + 5, 4));
\r
401 if($HeaderPoint > 0) {
\r
402 $$DATA = substr($$DATA, $HeaderPoint);
\r
403 $DataLength = length($$DATA);
\r
407 $Point += $MakerLength + 2;
\r
414 if(!$Ext && ($UnknownType || $ContentType =~ /^audio\//i)) {
\r
416 if($$DATA =~ /^MThd/) {
\r
418 } elsif($$DATA =~ /^\x2esnd/) { # ULAW Audio
\r
420 } elsif($$DATA =~ /^RIFF/ || $$DATA =~ /^ID3/ && $$DATA =~ /RIFF/) {
\r
421 my $HeaderPoint = index($$DATA, "RIFF", 0);
\r
422 $_ = substr($$DATA, $HeaderPoint + 8, 8);
\r
425 if(unpack("V",substr($$DATA, $HeaderPoint + 16, 4)) == 16) {
\r
427 } else { # RIFF WAVE MP3
\r
430 } elsif(/^RMIDdata$/) { # RIFF MIDI
\r
432 } elsif(/^RMP3data$/) { # RIFF MP3
\r
435 if($ContentType =~ /^audio\//i) {
\r
436 $Infomation .= '(RIFF '. substr($$DATA, $HeaderPoint + 8, 4). ')';
\r
444 if($$DATA =~ /^\%PDF/) {
\r
445 # Picture size is not measured.
\r
447 } elsif($$DATA =~ /^FWS/) { # Shockwave Flash
\r
449 } elsif($$DATA =~ /^RIFF/ || $$DATA =~ /^ID3/ && $$DATA =~ /RIFF/) {
\r
450 my $HeaderPoint = index($$DATA, "RIFF", 0);
\r
451 $_ = substr($$DATA,$HeaderPoint + 8, 8);
\r
456 if($ContentType =~ /^video\//i) {
\r
457 $Infomation .= '(RIFF '. substr($$DATA, $HeaderPoint + 8, 4). ')';
\r
459 } elsif($$DATA =~ /^PK/) { # ZIP Compress File
\r
461 } elsif($$DATA =~ /^MSCF/) { # CAB Compress File
\r
463 } elsif($$DATA =~ /^Rar\!/) { # RAR Compress File
\r
465 } elsif(substr($$DATA, 2, 5) =~ /^\-lh(\d+|d)\-$/) { # LHA Compress File
\r
466 $Infomation .= "(lh$1)";
\r
468 } 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
474 # Header analysis failure
\r
476 # It will be followed if it applies for the MIME type from the browser.
\r
477 foreach (keys %UPLOAD_CONTENT_TYPE_LIST) {
\r
479 if($ContentType =~ /^$_$/i) {
\r
480 $Ext = $UPLOAD_CONTENT_TYPE_LIST{$_};
\r
481 $ContentName = &CheckContentExt($Ext);
\r
483 grep {$_ eq $Ext;} (
\r
505 $Infomation .= ' / Header analysis failure';
\r
507 if($Ext ne $FileExt && &CheckContentExt($FileExt) eq $ContentName) {
\r
513 # a MIME type is unknown--It judges from an extension.
\r
515 $ContentName = &CheckContentExt($FileExt);
\r
518 $Infomation .= ' / MIME type is unknown('. $ContentType. ')';
\r
524 # $ContentName = &CheckContentExt($Ext) unless($ContentName);
\r
525 # if($Ext && $ContentName) {
\r
526 # $ContentName .= $Infomation;
\r
529 # 'Extension Error',
\r
530 # "$FileName A not corresponding extension ($Ext)<BR>The extension which can be responded ". join(',', sort values(%UPLOAD_EXT_LIST))
\r
534 # # SSI Tag Deletion
\r
535 # if($Ext =~ /.?html?/ && $$DATA =~ /<\!/) {
\r
544 # $$DATA =~ s/\#\s*$_/\&\#35\;$_/ig
\r
551 int($DataLength / 1024 + 1),
\r
558 ##############################################################################
\r
561 # Extension discernment
\r
566 ##############################################################################
\r
568 sub CheckContentExt
\r
573 foreach (keys %UPLOAD_EXT_LIST) {
\r
575 if($_ && $Ext =~ /^$_$/) {
\r
576 $ContentName = $UPLOAD_EXT_LIST{$_};
\r
580 return $ContentName;
\r
584 ##############################################################################
\r
592 ##############################################################################
\r
596 my($value,$Trans) = @_;
\r
598 # my $FormCode = &jcode::getcode($value) || $FormCodeDefault;
\r
599 # $FormCodeDefault ||= $FormCode;
\r
601 # if($Trans && $TRANS_2BYTE_CODE) {
\r
602 # if($FormCode ne 'euc') {
\r
603 # &jcode::convert($value, 'euc', $FormCode);
\r
607 # "\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA",
\r
610 # if($CHARCODE ne 'euc') {
\r
611 # &jcode::convert($value,$CHARCODE,'euc');
\r
614 # if($CHARCODE ne $FormCode) {
\r
615 # &jcode::convert($value,$CHARCODE,$FormCode);
\r
618 # if($CHARCODE eq 'euc') {
\r
619 # &jcode::h2z_euc($value);
\r
620 # } elsif($CHARCODE eq 'sjis') {
\r
621 # &jcode::h2z_sjis($value);
\r
626 ##############################################################################
\r
634 ##############################################################################
\r
639 local($error_message) = $_[0];
\r
640 local($error_message2) = $_[1];
\r
642 print "Content-type: text/html\n\n";
\r
646 <TITLE>Error Message</TITLE></HEAD>
\r
648 <table border="1" cellspacing="10" cellpadding="10">
\r
649 <TR bgcolor="#0000B0">
\r
650 <TD bgcolor="#0000B0" NOWRAP><font size="-1" color="white"><B>Error Message</B></font></TD>
\r
654 <H4> $error_message </H4>
\r
655 $error_message2 <BR>
\r
660 &rm_tmp_uploaded_files; # Image Temporary deletion
\r
664 ##############################################################################
\r
667 # Image Temporary deletion
\r
672 ##############################################################################
\r
674 sub rm_tmp_uploaded_files
\r
676 if($img_data_exists == 1){
\r
678 foreach $fname_list(@NEWFNAMES) {
\r
679 if(-e "$img_dir/$fname_list") {
\r
680 unlink("$img_dir/$fname_list");
\r