Working With Sub-Par Code

stonecolddevin has asked for the wisdom of the Perl Monks concerning the following question:

UPDATED: Pertidy'd code

Howdy everyone.

As much as it pains me to have anyone else look at this...hideous code, I need your help.

I'm trying to get an image upload script to work in an auction package (I DID NOT WRITE THIS PACKAGE, it is from http://www.ultimateauction.net), should be simple enough, but it has somehow exhausted all of my current knowledge on what could possibly be going wrong. I've looked at file permissions, directory permissions, paths, and added as much error checking as I think would be beneficial, but I'm not able to come up with anything.

Here's what it's spewing out:

Can't open the file.
Error:

admin_logo.gif No such file or directory
Note for the administrator: Check $Data Variable and
the absolute path to the image directory.
[download]

The path to the images, located in some variable named $config["image_upload_dir"} or some such, is /public_html/auctionimages/uploads/. I've checked this again and again to make sure this path is correct, but I just can't seem to get it to work.

Here's the code (I tried to pare it down to what I believe is pertinent):

#!/usr/bin/perl

######################################################################
+##########
#
#  Script Name : Ultimate Auction
#  Version     : 3.6
#  Company     : Ultimate Auction
#  Author      : Matt St. Amant ( webmaster@ultimateauction.net )
#  Website     : www.ultimateauction.net
#
#  Copyright (c) 2001-2002 Ultimate Auction (Matt St Amant) All rights
+ reserved.
#
#  Rules/License:  see license.txt that came with distribution.
#
#  This software license prohibits selling, giving away, or otherwise 
+distributing
#  the source code for any of the scripts contained in this SOFTWARE P
+RODUCT,
#  either in full or any subpart thereof. Nor may you use this source 
+code, in full or
#  any subpart thereof, to create derivative works or as part of anoth
+er program
#  that you either sell, give away, or otherwise distribute via any me
+thod.You must
#  not (a) reverse assemble, reverse compile, decode the Software or a
+ttempt to
#  ascertain the source code by any means, to create derivative works 
+by modifying
#  the source code to include as part of another program that you eith
+er sell, give
#  away, or otherwise distribute via any method, or modify the source 
+code in a way
#  that the Software looks and performs other functions that it was no
+t designed to;
#  (b) remove, change or bypass any copyright or Software protection s
+tatements
#  embedded in the Software; or (c) provide bureau services or use the
+ Software in
#  or for any other company or other legal entity.
#
#  Have Fun Using Ultimate Auction! :)
#
######################################################################
+##########
use strict;
use DBI;
use CGI;
use IO::Socket;
use UltimateAuction qw(%form $couser $copass $db $dbh %config @auction
+_types);
require "variables/variables.cgi";
require "variables/accountvars.cgi";
&UltimateAuction::service;
my %cookie = &UltimateAuction::get_cookie();
my $couser = $cookie{'Username'};
my $copass = $cookie{'Password'};

# connect to our database
my $db = &UltimateAuction::mysql_connect;
my @good_extensions =
  ( 'gif', 'jpg', 'jpeg', 'GIF', 'JPG', 'JPEG', 'png', 'PNG' );
my $max_num_files = $config{'upload_file_number'};
my $req = CGI->new;    # changed by dhoss on 11-27-2007
my $updisp;
my $usnm = $req->param('username');
my $pswd = $req->param('password');
my $usf  = $req->param('useform')
  ; # Cannot find this on the page, so my guess is this is from the pr
+evious use of this code.
######################################################################
+##########
# Vaildation chunk -
##################
# This little chunk of code is used to validate the user either via fo
+rm or
# cookies.
######################################################################
+##########
# Initialize this variables
my ( $usernum, $authuser, $authpass );

# Check for user name ($usnm), password ($pswd), and ($usf)?
# This chunk should never get hit as $usf is an unknown to this form o
+n the
# current auction script.
if ( $usnm and $pswd and $usf ) {
    ( $usernum, $authuser, $authpass ) =
      UltimateAuction::authenticate( $usnm, $pswd, 1, 1, $db );

    # If the user is logged in via form (Not cookies).
}
elsif ( $usnm and $pswd and !$usf ) {
    ( $usernum, $authuser, $authpass ) =
      UltimateAuction::authenticate( $usnm, $pswd, 0, 1, $db );

    # This one is for a cookie user.
}
else {
    ( $usernum, $authuser, $authpass ) =
      UltimateAuction::authenticate( $usnm, $pswd, 0, 0, $db );
}

# Checks now to see what 'UltimateAuction::authenticate' returned.  If
+ this is
# a valid user, then all of the following should be populated.  It ori
+ginally
# read !$usernum && !$authuser && !$authpass, but was changed to the c
+urrent
# form to make sure that ALL of these varibles were passed back.  If A
+LL of
# them are not passed back, send them to an authentication form.
if ( !$usernum || !$authuser || !$authpass ) {
    &UltimateAuction::auth_form( "", "Post New Item" );
######################################################################
+##########
    # End of the Vaildation chunk
######################################################################
+##########
}
else {
######################################################################
+##########
    # Image chunk - Notes add by Shawn McKinley 11-18-02
##################
   # Set the $method to that used by the form.  This will either be 'u
+rl' or
   # 'upload'.  'url' is for users that want to link to a picture they
+ have some
   # where else on the web.  'upload' is to store the picture on the q
+uicklysell
   # server.
    my $method = $req->param("method");

   # Set $number to the number of images that will be 'attached' to th
+is auction
   # item.  At this time, the choices are 0-5, but you should only get
+ to this
   # point if you have selected 1-5.
    my $number = $req->param("number");

   # Delete picture.  Not so sure that this should be here, but it was
+ obviously
   # a catch all to make sure that the picture did not already exist.
    &delpic;

    # Initialize the @images array.
    my @images;
#########################
    # This part is if the 'url' method was used.
#########################
    if ( $method eq 'url' ) {

        # Initialize $urlam. (url amount?)
        my $confirm;
        my $hidden;
        my $urlam = 0;

        # Iterrate over all the 'numbers' for images on the form
        for ( my $i = 1 ; $i <= $number ; $i++ ) {

     # If a url was found in imageX form element, increment $urlam by 
+1 and push
     # the url into the @images array.
            if ( $req->param("image$i") ) {
                $urlam++;
                push @images, $req->param("image$i");
            }
        }

   # No images were selected for upload, so send them back to the prev
+ious page.
        if ( !$urlam ) {
            print
qq~Location: $config{'script_dir'}/itemform.pl?method=none&number=none
+&username=$authuser&password=$authpass\n\n~;
        }

     # Set $word to 'Image';  I modified this to a turnary operation t
+o save
     # keystrokes, is easier to read, and the fact that it is faster t
+o execute.
        my $word = 'Image' . ( $urlam > 1 ? 's' : '' );

        #    my $header=&UltimateAuction::header; # Fetch the header
        #    &UltimateAuction::Display($header); # Display the Header
        # Modified this to a single satement...  Faster, readable, etc
+...
        &UltimateAuction::Display(&UltimateAuction::header);

        # Set this up as a color marker.  This will flip-flop ever oth
+er row.
        my $color = 'body1';

        # Iterate over each of the $urlam's
        for ( my $i = 0 ; $i <= $urlam ; $i++ ) {

        # If there is a URL for this image, then add it to the confirm
+ed section
            if ( $images[$i] ) {

                # Make a counter for the URL's
                my $count = $i + 1;

                # Add the chunk of HTML to the confirm section
                $confirm .=
qq~<TR><TD CLASS=$color>Image $count URL: <b>$images[$i]</b><p><IMG SR
+C="$images[$i]" BORDER=0></TD></TR>~;
                $hidden .=
                  qq~<INPUT TYPE=HIDDEN NAME=image$count VALUE="$image
+s[$i]">~;

          # Converted this from an if/then/else block.  Faster, readab
+le, etc...
          # We flip-flop the color here.
                $color = $color eq 'body1' ? 'body2' : 'body1';
            }
        }

    # Grab out doimageurl template and then replace each tag (<!- XXXX
+ -->) with
    # the appropriate variable.
        my $content = UltimateAuction::Open_Template("doimageurl.txt")
+;
        $content =~ s/<!-CONFIRM_IMAGE_URLS-->/$confirm/g;
        $content =~ s/<!-PRINT_HIDDEN_FIELDS-->/$hidden/g;
        $content =~ s/<!-DISPLAY_IMAGE_QUANTITY-->/$urlam/g;
        $content =~ s/<!-DISPLAY_IMAGE_OR_IMAGES-->/$word/g;
        $content =~ s/<!-IMAGE_METHOD-->/$method/g;
        $content =~ s/<!-URL_QUANTITY-->/$urlam/g;
        $content =~ s/<!-USERNAME-->/$authuser/g;
        $content =~ s/<!-PASSWORD-->/$authpass/g;
        &UltimateAuction::Display($content);    # Display the Page Con
+tents
        my $footer = &UltimateAuction::footer;  # Fetch the Footer
        &UltimateAuction::Display($footer);     # Display the Footer
#########################
        # This part is if the 'upload' method was used.
#########################
    }
    elsif ( $method eq 'upload' ) {

      # Set up these params
      # $formfields -> misc form fields?, $upam -> upload amount?,
      # $current_time,$final_time -> time now with server difference a
+djustment,
      # @was_not_good_type, @file_did_save, @did_not_save, @was_too_bi
+g ->
      # reporting arrays.
        my $formfields;
        my $upam         = 0;
        my $current_time = time + ( $config{'timediff'} * 3600 );
        my $final_time   = $current_time;
        my @was_not_good_type;
        my @file_did_save;
        my @did_not_save;
        my @was_too_big;

        # Iterate over the maximum number of files allowed.
        for ( my $a = 1 ; $a <= $max_num_files ; $a++ ) {

            # If fileN exists, then do the following
            if ( $req->param("FILE$a") ) {

                # Set $file and $filename to the current file name
                my $file     = $req->param("FILE$a");
                my $filename = $file;

       # Grab the extension of the filename by spliting the filename a
+ll periods
       # and using the last chunk of data for it.
                my $extension = ( split( /\./, $filename ) )[-1];

   # Set $fntwo (filename 2) to current time plus an underscore plus t
+he current
   # image number plus a lower case verion of the extension.
                my $fntwo = $final_time . "_$a." . lc($extension);

                # Change all '\'s in the filename to '/'s.
                #  $filename=~s/^.*(\\|\/)//;
                # initialize $proceed_type to 0
                my $proceed_type = 0;

  # Check to see if the @good_extensions array was initialized already
+ and if so
  # do the following.
                if (@good_extensions) {

                    # Iterate over all the good extensions
                    for (@good_extensions) {

  # There was an error here. By adding a '.' in line 2 and adding anot
+her '.' in
  # line 3, this would fail on any filename that was not like filename
+..gif
  #    1.            my $ext=$_;
  # 2.               $ext=~s/\.//g;
  #    3.            if($filename=~/\.$ext$/) {
  # 4.                   $proceed_type=1;
  #    5.                last;
  # 6.               }
  # Check to see if the $filename ends with the current extension. If 
+so, set
  # $proceed_type to 1 and exit out of the @good_extensions loop.
                        if ( $filename =~ /\.$_$/ ) { $proceed_type++;
+ last; }
                    }

    # Unless the filename ended in an acceptable extension, set this f
+ile in the
    # @was_not_good_type array.
                    unless ($proceed_type) {
                        push( @was_not_good_type, $filename );
                    }

     # If @good_extensions was not set up, set $proceed_type to 1.  Th
+is will
     # in effect let the user upload ANY file type.  Not an issue on t
+he current
     # script set up (as of 11-18-02) since @good_extensions was set u
+p.
                }
                else { $proceed_type = 1; }

        # Check to see if $proceed_type is 1 or greater, if so, do the
+ following
                if ($proceed_type) {

     # Open a pipe (OUTFILE) to the directory / filename so we can sav
+e our file
                    if (
                        open( OUTFILE, ">",
                            $config{'image_upload_dir'} . $fntwo
                        )
                      )
                    {

                # Read in the buffer that was sent with the form for t
+his image.
                        while ( my $bytesread =
                            read( $file, my $buffer, 1024 ) )
                        {

                            # Save (print) the contents of the file.
                            print OUTFILE $buffer;
                        }

                        # Close the pipe (OUTFILE) we created to save 
+the file
                        close(OUTFILE);

       # Add a hidden form field to $formfields with an image name equ
+alling the
       # new file name we created.
                        $formfields .=
                          qq~<INPUT TYPE=HIDDEN NAME=image$a VALUE="$f
+ntwo">\n~;

                        # Add HTML to the $updisp (upload display?).
                        $updisp .=
"<BR>Image $a: <IMG SRC=$config{'image_upload_url'}/$fntwo BORDER=0><b
+r>\n";

######################################################################
+##########
                        # PROBLEM
#########
    # Add the filename to the @file_did_save array.  May be a problem 
+here as we
    # did NO error checking to see if the file actually got saved.  No
+r does it
    # check to make sure that the file was NOT a 0 byte file (dummy). 
+ Will have
    # to look further into this one shortly.
######################################################################
+##########
                        push( @file_did_save, $filename );

                        # Increment $upam by one
                        $upam++;

     # Here, if the $proceed_type was not 1 or more, we add the file n
+ame to the
     # @did_not_save array.
                    }
                    else { push( @did_not_save, $filename . ' ' . $! )
+; }
                }

 # Check to see if the script was set to a maximum file size, if so, w
+e check to
 # see if the file to be uploaded exceeds this.  If so, we delete it a
+nd add
 # the filename to the @was_too_big array to be reported later.
######################################################################
+##########
                # PROBLEM
#########
# This should be checked before we actually save the file as a hacker 
+could
# flood fill the server with 4GB files until the server was full and e
+ffectively
# shut the server down completely...
######################################################################
+##########
                if ( $config{'max_file_size'} ) {
                    if ( ( -s "$config{'image_upload_dir'}/$fntwo" ) >
                        ( $config{'max_file_size'} * 1024 ) )
                    {
                        push( @was_too_big, $filename );
                        unlink("$config{'image_upload_dir'}/$fntwo");
                        $upam--;
                    }
                }
            }
        }

# Here we TRY to tell the browser not to cache the image.  Works about
+ half the
# time with about half of the browsers out there if you are lucky.  No
+t a big
# issue since there is no easy reliable way around this, not to mentio
+n that a
# quick shift-reload (control-reload) will do the same thing with most
+ browsers.
        print "Pragma: no-cache\n";

        #    my $header = &UltimateAuction::header; # Fetch the header
        #    &UltimateAuction::Display($header); # Display the Header
        # Combined these two lines...
        &UltimateAuction::Display(&UltimateAuction::header);

        # Initialize some more variables...
        # $results -> results from the uploading of the images to the 
+server,
        # $a -> a counter, $file,$filename -> the form version of the 
+filename,
        # $fntwo (filename 2) -> time + '_' + counter + lower case ext
+ension.
        my $results;
        my $a         = 1;
        my $file      = $req->param("FILE$a");
        my $filename  = $file;
        my $extension = ( split( /\./, $filename ) )[-1];
        my $fntwo     = $final_time . "_$a." . lc($extension);

  # Not real sure what this does... I will have to ask about, but my g
+uess is it
  # is an archaic form of loop control.
        $a <= $max_num_files;

        # increment $a by one.
        $a++;

      # here we check for each of the arrays and if we find a value in
+ them, add
      # a chunk of HTML with  those values in them.  Very fast and eff
+icient way
      # of doing it (nice bit of code here).
        if (@file_did_save) {
            $results .=
"<TR><TD CLASS=body2><B>The following picture(s) were uploaded success
+fully:<BR><BR>\n";
            $results .= join( "<BR>", @file_did_save );
            $results .= "<BR>$updisp\n";
        }
        if (@was_not_good_type) {
            $results .=
"<TR><TD CLASS=body2><B>The following picture(s) was not uploaded<BR>b
+ecause the file type is not allowed. Allowed formats are JPG, GIF and
+ PNG images:<BR><BR>\n";
            $results .= join( "<BR>", @was_not_good_type );
            $results .= "</TD></TR>";
        }
        if (@was_too_big) {
            $results .=
"<TR><TD CLASS=body2><B>The following picture was deleted,<BR>because 
+it has exceeded the maximum size we allow. The max. size image we all
+ow is $config{'max_file_size'} KB :<BR><BR>\n";
            $results .= join( "<BR>", @was_too_big );
            $results .= "</TD></TR>";
        }
        if (@did_not_save) {
            $results .=
              "<TR><TD CLASS=body2><B>Can't open the file.<BR>Error:<B
+R><BR>\n";
            $results .= join( "<BR>", @did_not_save );
            $results .= "</TD></TR>";
        }
        if ( !@file_did_save ) {
            $results .=
"<TR><TD CLASS=body2><FONT COLOR=\"RED\"><B>Note for the administrator
+: Check \$Data Variable and<BR>the absolute path to the image directo
+ry.</B></FONT><BR><BR></TD></TR>\n";
        }

 # Grab out doimageupload template and then replace each tag (<!- XXXX
+ -->) with
 # the appropriate variable.
        my $content = UltimateAuction::Open_Template("doimageupload.tx
+t");
        $content =~ s/<!-DISPLAY_UPLOAD_RESULTS-->/$results/;
        $content =~ s/<!-PRINT_HIDDEN_FIELDS-->/$formfields/;
        $content =~ s/<!-IMAGE_METHOD-->/$method/;
        $content =~ s/<!-UPLOAD_QUANTITY-->/$upam/;
        $content =~ s/<!-TEMP_UPLOAD_NAME-->/$final_time/;
        $content =~ s/<!-USERNAME-->/$authuser/;
        $content =~ s/<!-PASSWORD-->/$authpass/;
        &UltimateAuction::Display($content);    # Display the Page Con
+tents
        my $footer = &UltimateAuction::footer;  # Fetch the Footer
        &UltimateAuction::Display($footer);     # Display the Footer
    }

    # disconnect from our database
    $dbh->finish;
    &UltimateAuction::mysql_disconnect($db);
}

sub delpic {
    my ( @allfiles, $file, $filedate, $key );
    my $checktime = time;
    opendir PICDIR, "$config{'image_upload_dir'}";
    @allfiles = readdir PICDIR;
    closedir PICDIR;
    foreach $file (@allfiles) {
        if ( length($file) == 15 || length($file) == 16 ) {
            $filedate = substr( $file, 0, 9 );
            if ( ( $checktime - $filedate ) > 7200 ) {    # 2 hours
                unlink("$config{'image_upload_dir'}/$file");
            }
        }
    }
}
[download]

Help me if you can monks, and thank you very much to the brave soul who's able to conquer this beast.

meh.

Comment on Working With Sub-Par Code Select or Download Code

Replies are listed 'Best First'.
Re: Working With Sub-Par Code by tachyon-II (Chaplain) on Nov 29, 2007 at 08:45 UTC
This is possibly the ugliest code I have ever seen. The comments essentially obfuscate the code and the indentation is semi-random. I suggest you get a copy of Perltidy and run the code through it with the -dbc option to delete the comments and fix the indentation, that way you can actually see the code and control logic. As it stands it is essentially unreadable and unmaintainable. If you search for the error message "Can't open the file" you will find the `if(@did_not_save)` that triggers it. Go and find where @did_not_save is set and you will see the logic that makes this happen. Observe that the error message filename and the name of the file being opened are different, fix that, get a useful error message......	[reply] [d/l]
Re^2: Working With Sub-Par Code by Your Mother (Archbishop) on Nov 29, 2007 at 23:26 UTC
This is possibly the ugliest code I have ever seen. Lucky. The best part is when it looks like that but is spread across 10 modules, 5 eval'd scripts, a customized environment without documentation running under Registry, and lots of Perl 4 style.	[reply]
Re: Working With Sub-Par Code by Anonymous Monk on Nov 29, 2007 at 08:09 UTC
I see `if(open(OUTFILE,">", $config{'image_upload_dir'}.$fntwo)) {` [download] is different from `if((-s "$config{'image_upload_dir'}/$fntwo") > ($config{'max_file_size +'} * 1024)) { push(@was_too_big, $filename); unlink("$config{'image_upload_dir'}/$fntwo");` [download] I would perltidy	[reply] [d/l] [select]
Re: Working With Sub-Par Code by andreas1234567 (Vicar) on Nov 29, 2007 at 10:18 UTC
I guess part of your problem is that the `$filename` is appended to the `@file_did_save` array regardless of what open returns: `if (open(OUTFILE, ... )) { push(@file_did_save, $filename); } else { push(@did_not_save, $filename . ' ' . $!); }` [download] As pointed out by Anonymous Monk, the line `$config{'image_upload_dir'}.$fntwo` [download] should probably be `$config{'image_upload_dir'} . '/' . $fntwo` [download] or, even better (with File::Spec::Functions) `use File::Spec::Functions; catfile($config{'image_upload_dir'}, $fntwo)` [download] which would make it platform independent (and IMHO) more readable. I second the perltidy recommendations. Update: Fixed typo as noted by shmem. -- Andreas	[reply] [d/l] [select]
Re^2: Working With Sub-Par Code by shmem (Chancellor) on Nov 29, 2007 at 12:06 UTC
should probably be `$config{'image_upload_dir'}/$fntwo` [download] Huh? divide, really? I guess you mean `$config{'image_upload_dir'}."/$fntwo";` [download] --shmem _($_=" "x(1<<5)."?\n".q·/)Oo. G°\ / /\_¯/(q / ---------------------------- \__(m.====·.(_("always off the crowd"))."· ");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}	[reply] [d/l] [select]