httemplate/elements/fckeditor/editor/filemanager/connectors/perl/commands.pl

   1 #####\r
   2 #  FCKeditor - The text editor for Internet - http://www.fckeditor.net\r
   3 #  Copyright (C) 2003-2010 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 sub GetFolders\r
  25 {\r
  26 \r
  27         local($resourceType, $currentFolder) = @_;\r
  28 \r
  29         # Map the virtual path to the local server path.\r
  30         $sServerDir = &ServerMapFolder($resourceType, $currentFolder);\r
  31         print "<Folders>";                      # Open the "Folders" node.\r
  32 \r
  33         opendir(DIR,"$sServerDir");\r
  34         @files = grep(!/^\.\.?$/,readdir(DIR));\r
  35         closedir(DIR);\r
  36 \r
  37         foreach $sFile (@files) {\r
  38                 if($sFile != '.' && $sFile != '..' && (-d "$sServerDir$sFile")) {\r
  39                         $cnv_filename = &ConvertToXmlAttribute($sFile);\r
  40                         print '<Folder name="' . $cnv_filename . '" />';\r
  41                 }\r
  42         }\r
  43         print "</Folders>";                     # Close the "Folders" node.\r
  44 }\r
  45 \r
  46 sub GetFoldersAndFiles\r
  47 {\r
  48 \r
  49         local($resourceType, $currentFolder) = @_;\r
  50         # Map the virtual path to the local server path.\r
  51         $sServerDir = &ServerMapFolder($resourceType,$currentFolder);\r
  52 \r
  53         # Initialize the output buffers for "Folders" and "Files".\r
  54         $sFolders       = '<Folders>';\r
  55         $sFiles         = '<Files>';\r
  56 \r
  57         opendir(DIR,"$sServerDir");\r
  58         @files = grep(!/^\.\.?$/,readdir(DIR));\r
  59         closedir(DIR);\r
  60 \r
  61         foreach $sFile (@files) {\r
  62                 if($sFile ne '.' && $sFile ne '..') {\r
  63                         if(-d "$sServerDir$sFile") {\r
  64                                 $cnv_filename = &ConvertToXmlAttribute($sFile);\r
  65                                 $sFolders .= '<Folder name="' . $cnv_filename . '" />' ;\r
  66                         } else {\r
  67                                 ($iFileSize,$refdate,$filedate,$fileperm) = (stat("$sServerDir$sFile"))[7,8,9,2];\r
  68                                 if($iFileSize > 0) {\r
  69                                         $iFileSize = int($iFileSize / 1024);\r
  70                                         if($iFileSize < 1) {\r
  71                                                 $iFileSize = 1;\r
  72                                         }\r
  73                                 }\r
  74                                 $cnv_filename = &ConvertToXmlAttribute($sFile);\r
  75                                 $sFiles .= '<File name="' . $cnv_filename . '" size="' . $iFileSize . '" />' ;\r
  76                         }\r
  77                 }\r
  78         }\r
  79         print $sFolders ;\r
  80         print '</Folders>';                     # Close the "Folders" node.\r
  81         print $sFiles ;\r
  82         print '</Files>';                       # Close the "Files" node.\r
  83 }\r
  84 \r
  85 sub CreateFolder\r
  86 {\r
  87 \r
  88         local($resourceType, $currentFolder) = @_;\r
  89         $sErrorNumber   = '0' ;\r
  90         $sErrorMsg              = '' ;\r
  91 \r
  92         if($FORM{'NewFolderName'} ne "") {\r
  93                 $sNewFolderName = $FORM{'NewFolderName'};\r
  94                 $sNewFolderName =~ s/\.|\\|\/|\||\:|\?|\*|\"|<|>|[[:cntrl:]]/_/g;\r
  95                 # Map the virtual path to the local server path of the current folder.\r
  96                 $sServerDir = &ServerMapFolder($resourceType, $currentFolder);\r
  97                 if(-w $sServerDir) {\r
  98                         $sServerDir .= $sNewFolderName;\r
  99                         $sErrorMsg = &CreateServerFolder($sServerDir);\r
 100                         if($sErrorMsg == 0) {\r
 101                                 $sErrorNumber = '0';\r
 102                         } elsif($sErrorMsg eq 'Invalid argument' || $sErrorMsg eq 'No such file or directory') {\r
 103                                 $sErrorNumber = '102';          #// Path too long.\r
 104                         } else {\r
 105                                 $sErrorNumber = '110';\r
 106                         }\r
 107                 } else {\r
 108                         $sErrorNumber = '103';\r
 109                 }\r
 110         } else {\r
 111                 $sErrorNumber = '102' ;\r
 112         }\r
 113         # Create the "Error" node.\r
 114         $cnv_errmsg = &ConvertToXmlAttribute($sErrorMsg);\r
 115         print '<Error number="' . $sErrorNumber . '" />';\r
 116 }\r
 117 \r
 118 sub FileUpload\r
 119 {\r
 120 eval("use File::Copy;");\r
 121 \r
 122         local($resourceType, $currentFolder) = @_;\r
 123         $allowedExtensions = $allowedExtensions{$resourceType};\r
 124 \r
 125         $sErrorNumber = '0' ;\r
 126         $sFileName = '' ;\r
 127         if($new_fname) {\r
 128                 # Map the virtual path to the local server path.\r
 129                 $sServerDir = &ServerMapFolder($resourceType,$currentFolder);\r
 130 \r
 131                 # Get the uploaded file name.\r
 132                 $sFileName = $new_fname;\r
 133                 $sFileName =~ s/\\|\/|\||\:|\?|\*|\"|<|>|[[:cntrl:]]/_/g;\r
 134                 $sFileName =~ s/\.(?![^.]*$)/_/g;\r
 135 \r
 136                 $ext = '';\r
 137                 if($sFileName =~ /([^\\\/]*)\.(.*)$/) {\r
 138                         $ext  = $2;\r
 139                 }\r
 140 \r
 141                 $allowedRegex = qr/^($allowedExtensions)$/i;\r
 142                 if (!($ext =~ $allowedRegex)) {\r
 143                         SendUploadResults('202', '', '', '');\r
 144                 }\r
 145 \r
 146                 $sOriginalFileName = $sFileName;\r
 147 \r
 148                 $iCounter = 0;\r
 149                 while(1) {\r
 150                         $sFilePath = $sServerDir . $sFileName;\r
 151                         if(-e $sFilePath) {\r
 152                                 $iCounter++ ;\r
 153                                 ($path,$BaseName,$ext) = &RemoveExtension($sOriginalFileName);\r
 154                                 $sFileName = $BaseName . '(' . $iCounter . ').' . $ext;\r
 155                                 $sErrorNumber = '201';\r
 156                         } else {\r
 157                                 copy("$img_dir/$new_fname","$sFilePath");\r
 158                                 if (defined $CHMOD_ON_UPLOAD) {\r
 159                                         if ($CHMOD_ON_UPLOAD) {\r
 160                                                 umask(000);\r
 161                                                 chmod($CHMOD_ON_UPLOAD,$sFilePath);\r
 162                                         }\r
 163                                 }\r
 164                                 else {\r
 165                                         umask(000);\r
 166                                         chmod(0777,$sFilePath);\r
 167                                 }\r
 168                                 unlink("$img_dir/$new_fname");\r
 169                                 last;\r
 170                         }\r
 171                 }\r
 172         } else {\r
 173                 $sErrorNumber = '202' ;\r
 174         }\r
 175         $sFileName      =~ s/"/\\"/g;\r
 176 \r
 177         SendUploadResults($sErrorNumber, $GLOBALS{'UserFilesPath'}.$resourceType.$currentFolder.$sFileName, $sFileName, '');\r
 178 }\r
 179 \r
 180 sub SendUploadResults\r
 181 {\r
 182 \r
 183         local($sErrorNumber, $sFileUrl, $sFileName, $customMsg) = @_;\r
 184 \r
 185         # Minified version of the document.domain automatic fix script (#1919).\r
 186         # The original script can be found at _dev/domain_fix_template.js\r
 187         # Note: in Perl replace \ with \\ and $ with \$\r
 188         print <<EOF;\r
 189 Content-type: text/html\r
 190 \r
 191 <script type="text/javascript">\r
 192 (function(){var d=document.domain;while (true){try{var A=window.parent.document.domain;break;}catch(e) {};d=d.replace(/.*?(?:\\.|\$)/,'');if (d.length==0) break;try{document.domain=d;}catch (e){break;}}})();\r
 193 \r
 194 EOF\r
 195         print 'window.parent.OnUploadCompleted(' . $sErrorNumber . ',"' . JS_cnv($sFileUrl) . '","' . JS_cnv($sFileName) . '","' . JS_cnv($customMsg) . '") ;';\r
 196         print '</script>';\r
 197         exit ;\r
 198 }\r
 199 \r
 200 1;\r