Perl Not Writing to Buffer

Question

For many years, I have used the following perl code I downloaded from a site to upload files to our linux server. Basically, the user types a username and password into an html form, selects the file to upload, and clicks submit. The script does the rest. For some reason last week, the script stopped working. I know it is opening the file to write to because I tried commenting out the 'unlink' line which would remove the file if nothing is written to it. It does open the file for writing on the server, but when I open the file, there is nothing there. I've tried changing file permissions and ownership on the directory where the uploaded files are stored without any results. Any ideas or suggestions? Thanks!

 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

It appears clear that the problem lies with the file being uploaded, outside of (before) the shown code. The code prints to $file_name obtained by cleaning up $file_query, which is pulled from $query. This is the CGI object itself that is passed into the sub. I cannot see anything in the code that would mess with the data to be used to write the $file_name.

This would imply that the data for which $file_query is a filehandle is (sometimes) missing, so when you copy it via your read() loop to $file_name you get nothing.

The one thing I can recommend is to test for the size of the (temp) file that is being copied into $file_name. See Update below for how to do that. Any other diagnostics would have to happen elsewhere, so it seems.

Another (distant?) possibility is that the filehandle pulled from $query has been used to read (or write) and does not any more point to the beginning of the file -- but rather to the end. This would also not be in the shown code. Update: it may be worth trying seek $query_file, 0, 0 before the read loop, to 'rewind` to the beginning of the file.

The code can be improved but I don't see how any of it can cause this problem.

---

Update

The script reads via read($file_query, ...), where $file_query is set earlier by

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

The query->param returns names of things, while read needs a filehandle. By CGI's convenience what is returned by param can be used as a filehandle as well. However, a filehandle is properly obtained from the CGI object by the method $query->upload('file').

Then it would be worth trying to get the filehandle via upload method and use that in the read loop, instead of $file_query. See File upload section in CGI docs.

---

Update

From File upload in CGI.pm docs

When processing an uploaded file, CGI.pm creates a temporary file on your hard disk and passes you a file handle to that file.

Check this file to see whether the file made it to the server at all. Do this before the upload() sub. The linked docs give us

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

Now $tmpfilename can be queried for size, for example by the same stat your code uses to check the $file_name size, or simply using Perl's file-test operators

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

If that file is zero-size you know that the problem is earlier.