Perl Not Writing to Buffer

Question

В течение многих лет я использовал следующий код Perl, который я загрузил с сайта, чтобы загрузить файлы на наш Linux-сервер. В принципе, пользователь вводит имя пользователя и пароль в html-форму, выбирает файл для загрузки и нажимает кнопку submit. Сценарий делает все остальное. По какой-то причине на прошлой неделе сценарий перестает работать. Я знаю, что он открывает файл для записи, потому что я попытался прокомментировать строку «unlink», которая удалит файл, если на него ничего не написано. Он открывает файл для записи на сервере, но когда я открываю файл, там ничего нет. Я попытался изменить права доступа к файлам и права собственности на каталог, в котором загруженные файлы хранятся без каких-либо результатов. Любые идеи или предложения? Благодаря!

my $DATA_DIR = '/Absolute/path/to/datadir/'; # Path of data directory 
my $DEFAULT_UPLOAD_DIR = '/tmp/'; #used only if you don't use password. 

my $MAX_SIZE_UPLOAD = 25; # Ko 
# File sizes are limited to $MAX_SIZE_UPLOAD (0 No limit), larger files will 
# return an 'Internal Server Error'. 

my $FORM_URL = 'http://www.yourdomain.com/upload.html'; 

my $WEBMASTER_EMAIL = 'you@yourdomain.com'; 

my $DISPLAY_LANG = 'En'; # Fr -> french 

my $USE_PASSWORD_PROTECT = 1; # 1 to use password protect 0 else. 
my $PASSWORD_FILE = $DATA_DIR.'password.txt'; # Name of Password file 

# En: Define all messages and buttons text. 
# Fr: Definition des messages et des boutons 
my(%NAME_BUTTON, %NAME_HEADTAB, %NAME_TITLE); 

if ($DISPLAY_LANG eq 'Fr') { 
%NAME_BUTTON = ('exit' => 'Sortir', 'back' => 'Retour', 'add' => 'Ok', 
    'add_user' => 'Ajouter', 'edit_user' => 'Edit', 'del_user' => 'Supprimer', 'log' => 'Entrer'); 
%NAME_HEADTAB = ('name' => 'Nom', 'level' => 'Droits', 'user_path' => 'Répertoire utilisateur', 
    'login' => 'Identifiant', 'password' => 'Mot de passe', 'new_login' => 'Nouvel identifiant', 
    'new_pass' => 'Nouveau mot de passe', 'conf_pass' => 'Confimer mot de passe', 
    'admin' => 'Administrateur', 'member' => 'Membre', 'w_path' => "(Chemin inexistant !)"); 
%NAME_TITLE = ('common_admin' => "eUpload, écran d'administration", 'common_member' => 'eUpload, écran de chargement', 
    'error_form' => 'Erreur : Formulaire incomplet', 'manage_users' => 'Management des utilisateurs', 'edit_user' => "Editer 'Value_login' utilisateur", 'add_user' => 'Ajout d\'un utilisateur', 
    'user_saved' => "Utilisateur 'Value_login' savé", 'user_added' => "Nouvel utilisateur 'Value_login' ajouté", 'user_deleted' => "Utilisateur 'Value_new_login' supprimé", 
    'change_pass' => 'Changer votre mot de passe', 'chpass_invalid' => 'Nouveau mot de passe invalide', 'chpass_updated' => 'Mot de passe de Value_login mis à jour', 
    'enter_pass' => 'Entrer votre mot de passe', 'invalid_pass' => 'MOT de PASSE INCORECT', 
    'EU_BadFN' => "Error: Nom de fichier 'Value_FileName' incorrect", 'EU_FExist' => "Error: Fichier 'Value_FileName' existant, impossible de le modifier!", 
    'EU_Size' => "Error: Erreur de chargement de 'Value_FileName'", 'Upload_Succes' => 'Chargement réussi !', 
    'Upload_Succes_txt' => "'Value_FileName' (Value_Size bytes, Value_Time s) est sauvé"); 
} else { 
%NAME_BUTTON = ('exit' => 'Exit', 'back' => 'Back', 'add' => 'Ok', 
    'add_user' => 'Add', 'edit_user' => 'Edit', 'del_user' => 'Remove', 'log' => 'Log in'); 
%NAME_HEADTAB = ('name' => 'Name', 'level' => 'Level', 'user_path' => "User path", 
    'login' => 'Login', 'password' => 'Password', 'new_login' => 'New Login', 
    'new_pass' => 'New password', 'conf_pass' => 'Confim password', 
    'admin' => 'Administrator', 'member' => 'Member', 'w_path' => "(Path don't exist !)"); 
%NAME_TITLE = ('common_admin' => "eUpload, administrative display", 'common_member' => "eUpload, upload display", 
    'error_form' => 'Error : Incomplet form', 'manage_users' => 'Manage Users', 'edit_user' => "Edit 'Value_login' user", 'add_user' => 'Add a user', 
    'user_saved' => "User 'Value_login' saved", 'user_added' => "New user 'Value_login' added", 'user_deleted' => "User 'Value_new_login' deleted", 
    'enter_pass' => 'Enter your password', 'invalid_pass' => 'INVALID PASSWORD', 
    'EU_BadFN' => "Error: Bad Name 'Value_FileName'", 'EU_FExist' => "Error: File 'Value_FileName' exists, can not overwrite !", 
    'EU_Size' => "Error: Could not upload file: 'Value_FileName'", 'Upload_Succes' => 'Upload uploaded successfully!', 
    'Upload_Succes_txt' => "'Value_FileName' (Value_Size bytes, Value_Time s) was saved"); 

}

use strict; 
use CGI; 
if ($MAX_SIZE_UPLOAD) { $CGI::POST_MAX=1024 * $MAX_SIZE_UPLOAD; } # Ko 
# File sizes are limited to 25K, larger files will return an 'Internal Server Error' 

my $query = new CGI; 

my $login = $query->param('login'); 
my $password = $query->param('pass'); 
my $action = $query->param('ac'); 

my ($dir); 

if ($query->param('BT_Exit')) { $action = ''; } 


if ($action eq 'admin') { 
print $query->header; 
if ($login && $password) { 
    &admin($query, $login, $password); 
} else { 
    print &PagePassword($NAME_TITLE{'common_admin'}); 
} 
} elsif ($action eq 'upload') { 
print $query->header; 
if ($dir = &check_password('guest', $login, $password)) { 
    print &Upload($query, $dir); 
} else { 
    print &BadPassword($NAME_TITLE{'common_member'}); 
} 
} else { 
print $query->redirect($FORM_URL); 
} 


sub Upload { 
my($query, $upload_dir) = @_; 
my($file_query, $file_name, $size, $buff, $time, $bytes_count); 
$size = $bytes_count =0; 
$_ = $file_query = $query->param('file'); 
s/\w://; 
s/([^\/\\]+)$//; 
$_ = $1; 
s/\.\.+//g; 
s/\s+//g; 
$file_name = $_; 

if (! $file_name) { 
    $_ = $NAME_TITLE{'EU_BadFN'}; 
    s/Value_FileName/$file_name/ig; 
    &Error($_, 1); 
} 

if (-e "$upload_dir/$file_name") { 
    $_ = $NAME_TITLE{'EU_FExist'}; 
    s/Value_FileName/$file_name/ig; 
    &Error($_, 1); 
} 

open(FILE,">$upload_dir/$file_name") || &Error("Error opening file  $file_name for writing, error $!", 1); 
binmode FILE; 
$time=time(); 
while ($bytes_count = read($file_query,$buff,2096)) { 
    $size += $bytes_count; 
    print FILE $buff; 
} 
close(FILE); 

if ((stat "$upload_dir/$file_name")[7] <= 0) { 
    unlink("$upload_dir/$file_name"); 
    $_ = $NAME_TITLE{'EU_Size'}; 
    s/Value_FileName/$file_name/ig; 
    &Error($_, 1); 
} else { 
    $time = time -$time; 
    $_ = $NAME_TITLE{'Upload_Succes_txt'}; 
    s/Value_FileName/$file_name/ig; 
    s/Value_Size/$size/ig; 
    s/Value_Time/$time/ig; 
    &ResutPage($NAME_TITLE{'Upload_Succes'}, $_); 
} 
} 

Answer 1

Представляется очевидным, что проблема заключается в загружаемом файл, за пределами (до) проявленного кода. Код распечатывается до $file_name, полученный путем очистки $file_query, который вытягивается с $query. Это сам объект CGI, который передается в sub. Я не вижу ничего в коде, который бы испортил данные, которые будут использоваться для записи $file_name.

Это будет означать, что данные, для которых $file_query является указатель_на_файлом является (иногда) отсутствует, поэтому при копировании через вашу read() петлю, чтобы $file_name вы ничего не получите.

Единственное, что я могу порекомендовать, это проверить размер файла (temp), который копируется в $file_name. Чтобы узнать, как это сделать, см. Ниже. Любая другая диагностика должна произойти в другом месте, так что кажется.

Еще одна (удаленная?) Возможность состоит в том, что дескриптор файла, снятый с $query, использовался для чтения (или записи) и больше не указывает на начало файла, а скорее на конец. Это также не было бы в показанном коде. Обновление: Возможно, стоит попробовать seek $query_file, 0, 0 перед циклом read, чтобы «перемотать» в начало файла.

Код может быть улучшен, но я не вижу, как это может вызвать эту проблему.

---

Update

Скрипт читает через read($file_query, ...), где $file_query установлен ранее

$_ = $file_query = $query->param('file') 

В query->param возвращает имена вещей, в то время как read нужен дескриптор. По удобству CGI то, что возвращается paramможет также использоваться в качестве дескриптора файла. Однако дескриптор файла правильно получается из объекта CGI по методу $query->upload('file').

Тогда было бы целесообразно получить дескриптор файла с помощью метода upload и использовать его в цикле read вместо $file_query. См. Раздел File upload в статьях CGI.

---

Update

От File upload в CGI.pm Docs

При обработке загруженного файла, CGI.pm создает временный файл на жестком диске и передает вам дескриптор файла к этому файлу.

Проверить этот файл, чтобы увидеть ли сделал это файл на сервер вообще. Сделайте это до upload() под. Связанные документы дают нам

my $fh_tmp = $query->upload('file'); 
my $tmpfilename = $query->tmpFileName($fh_tmp); 

Теперь $tmpfilename может быть запрошен по размеру, например, по тому же stat код используется для проверки $file_name размера, или просто используя в Perl file-test operators

(if -z $tmpfilename) { print "Empty file (exists but zero size)!\n" } 

Если что файл нулевого размера, вы знаете, что проблема ранее.