Perl 不写入缓冲区
Perl Not Writing to Buffer
多年来，我一直使用从站点下载的以下 perl 代码将文件上传到我们的 linux 服务器。基本上，用户在 html 表单中输入用户名和密码，选择要上传的文件，然后单击提交。脚本完成剩下的工作。由于某种原因，上周该脚本停止工作。我知道它正在打开要写入的文件，因为我尝试注释掉 '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/([^\/\]+)$//;
$_ = ;
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'}, $_);
}
}
很明显，问题出在所上传的文件上，在所示代码之外（之前）。代码打印到通过清理 $file_query 获得的 $file_name，它是从 $query 中拉出的。这是传递给子程序的 CGI 对象本身。我在代码中看不到任何会混淆用于写入 $file_name 的数据的内容。
这意味着 $file_query 作为文件句柄的数据（有时）丢失，因此当您通过 read() 循环将其复制到 $file_name 时，您什么也得不到。
我可以推荐的一件事是测试正在复制到 $file_name 中的（临时）文件的大小。 请参阅下面的更新以了解如何执行此操作。 任何其他诊断都必须在其他地方进行，看来如此。
另一种（遥远的？）可能性是从 $query 中提取的文件句柄已用于读取（或写入）并且不再指向文件的开头 - 而是指向结尾.这也不在显示的代码中。 更新：可能值得在 read 循环之前尝试 seek $query_file, 0, 0，以“倒回”到文件的开头。
代码可以改进，但我看不出任何代码会导致此问题。
更新
脚本通过 read($file_query, ...) 读取，其中 $file_query 之前由
设置
$_ = $file_query = $query->param('file')
query->param returns 事物的名称，而 read 需要一个文件句柄。为了方便 CGI，param 返回的内容也可以 用作文件句柄。然而，文件句柄是通过 $query->upload('file').
方法从 CGI 对象正确获得的
那么值得尝试通过 upload 方法获取文件句柄并在 read 循环中使用它，而不是 $file_query。请参阅 File upload section in CGI 文档。
更新
来自 CGI.pm 文档中的 File upload
When processing an uploaded file, CGI.pm creates a temporary file on your hard disk and passes you a file handle to that file.
检查此 文件以查看该文件是否已到达服务器。在 upload() 子之前执行此操作。链接的文档给了我们
my $fh_tmp = $query->upload( 'file' );
my $tmpfilename = $query->tmpFileName( $fh_tmp );
现在可以查询 $tmpfilename 的大小，例如通过您的代码用于检查 $file_name 大小的相同 stat，或者简单地使用 Perl 的 file-test operators
(if -z $tmpfilename) { print "Empty file (exists but zero size)!\n" }
如果那个 文件大小为零，您就知道问题更早了。
多年来，我一直使用从站点下载的以下 perl 代码将文件上传到我们的 linux 服务器。基本上，用户在 html 表单中输入用户名和密码，选择要上传的文件，然后单击提交。脚本完成剩下的工作。由于某种原因，上周该脚本停止工作。我知道它正在打开要写入的文件，因为我尝试注释掉 '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/([^\/\]+)$//;
$_ = ;
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'}, $_);
}
}
很明显，问题出在所上传的文件上，在所示代码之外（之前）。代码打印到通过清理 $file_query 获得的 $file_name，它是从 $query 中拉出的。这是传递给子程序的 CGI 对象本身。我在代码中看不到任何会混淆用于写入 $file_name 的数据的内容。
这意味着 $file_query 作为文件句柄的数据（有时）丢失，因此当您通过 read() 循环将其复制到 $file_name 时，您什么也得不到。
我可以推荐的一件事是测试正在复制到 $file_name 中的（临时）文件的大小。 请参阅下面的更新以了解如何执行此操作。 任何其他诊断都必须在其他地方进行，看来如此。
另一种（遥远的？）可能性是从 $query 中提取的文件句柄已用于读取（或写入）并且不再指向文件的开头 - 而是指向结尾.这也不在显示的代码中。 更新：可能值得在 read 循环之前尝试 seek $query_file, 0, 0，以“倒回”到文件的开头。
代码可以改进，但我看不出任何代码会导致此问题。
更新
脚本通过 read($file_query, ...) 读取，其中 $file_query 之前由
$_ = $file_query = $query->param('file')
query->param returns 事物的名称，而 read 需要一个文件句柄。为了方便 CGI，param 返回的内容也可以 用作文件句柄。然而，文件句柄是通过 $query->upload('file').
那么值得尝试通过 upload 方法获取文件句柄并在 read 循环中使用它，而不是 $file_query。请参阅 File upload section in CGI 文档。
更新
来自 CGI.pm 文档中的 File upload
When processing an uploaded file, CGI.pm creates a temporary file on your hard disk and passes you a file handle to that file.
检查此 文件以查看该文件是否已到达服务器。在 upload() 子之前执行此操作。链接的文档给了我们
my $fh_tmp = $query->upload( 'file' );
my $tmpfilename = $query->tmpFileName( $fh_tmp );
现在可以查询 $tmpfilename 的大小，例如通过您的代码用于检查 $file_name 大小的相同 stat，或者简单地使用 Perl 的 file-test operators
(if -z $tmpfilename) { print "Empty file (exists but zero size)!\n" }
如果那个 文件大小为零，您就知道问题更早了。