Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

How many bugs can *you* find

by Ovid (Cardinal)
on May 01, 2001 at 01:12 UTC ( #76754=perlmeditation: print w/ replies, xml ) Need Help??

I'm busy creating new functionality for a Web site and I was asked to look at a similar page on the site and "modify" its functionality to fit my needs. Aside from the potential for duplicate code (which I will have), I discovered that the core functionality that I needed to look at rested in the following subroutine. How many bugs, or potential security holes, can you find?

Note: I have changed some of the information to protect the customer in question, but I have not changed any of the bugs.

sub updateTiles { my $fto = $htmDir . 'tile.htm'; my $content = ''; open(HOME,$fto); while (<HOME>) { $content .= $_ } close(HOME); my $paramTemp,$contentTemp; my @sections = qw(Tile Pile Link); foreach $section (@sections) { $contentTemp = $query->param($section); if ($section eq 'Pile') { $contentTemp =~ s/[\n\r]/<p>/g; } if ($section eq 'Link') { $contentTemp = "<img src=\"images/en +ter.gif\" width=8 height=12><a href=\"cgi-bin/show.cgi?action=showTil +es&tileType=Search&searchFor=$contentTemp\">View this month's tiles.< +/a>" } $content =~ s/<!--$section-->(.*)/<!--$section-->$contentTemp/ +; } open(HOME,">$fto"); print HOME $content; close(HOME); my $image = $query->param('Image'); if ($image ne '') { my $newFile = fileUpload('Image',250000,1,'lat +est_image','JPEG','.jpg','.jpeg') } }

Cheers,
Ovid

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

Comment on How many bugs can *you* find
Download Code
Trick Question
by gryng (Hermit) on May 01, 2001 at 01:24 UTC
    Trick question, none; Perl is infinitely secure :) .

    Ciao,
    Gryn

Re: How many bugs can *you* find
by tinman (Curate) on May 01, 2001 at 01:30 UTC

    Ovid, thank you for doing something like this.. I wanted to, but I suppose I never had the courage to actually try it out.. Its going to help my awareness of any bad coding practices immensely..

    Ok, first thing: you're not checking the return results of *any* file open call... not for reading and not for writing.. there should always be a "or die" handler for all the open calls

    Umm.. a biggie, but I don't think you're untainting any of the file name variables or the param variables that you recieve from the user... so a script kiddie style "rm -rf" hack is possible..

    When you open a file for writing, you don't bother to lock (flock)it.. I've personally been bitten by a lot of flock issues when I do CGI, so I noticed this..

    Your comparison (eq 'Link' || 'Pile') doesn't take into consideration a lower case submission ('link', 'pile' etc)
    Update:Whoops, not so sure about this

    Well, that's all I can see for now... please do tell if I've concentrated on the smaller nitpicky issues and missed any big ones...

Re: How many bugs can *you* find
by satchboost (Scribe) on May 01, 2001 at 01:35 UTC
    Let's see...
    1) Using global variables like $htmlDir.
    2) Hardcoding the filename tile.htm (This both reduces the capability of the function as well as allowing someone to figure out what file needs messing with.)
    3) The foreach loop should be foreach my $section (@sections) to avoid clobbering $section in the surrounding scope.
    4) Just to be nitpicky, but it should be elsif ($section eq 'Link')
    5) $contentTemp =~ s/[\n\r]/<p>/g; will give different behavior whether on Win32 or Unix. This would be better as s/\n\r?/<p>/g; instead. In addition, doesn't Mac have a different carriage return sequence, too?
      A nitpick on your nitpicks, [\n\r] is a character class, so it works correctly.
         MeowChow                                   
                     s aamecha.s a..a\u$&owag.print
        To nitpick further, [\n\r] will replace every instance of \n or \r with a <p>. That means that, on Win32, you'll get two <p> and only one on Unix.
Re: How many bugs can *you* find
by MeowChow (Vicar) on May 01, 2001 at 01:39 UTC
    Ooh, fun! Pick apart code without worrying about hurting someone's ego ;)
    my $fto = $htmDir . 'tile.htm'; # yuck: hard-coded file name in a subroutine open(HOME,$fto); # blargh, no error checks, are we using -T, and if not, is $htmDir # based on user-supplied data? foreach $section (@sections) { # if this compiles, I guess we're not using strict, eh? ($section is # not declared my) # # ... I don't even want to comment on the nastiness of the innards of +the # foreach loop, but I will anyway. Iterating over the hard-coded value +s in @section, only # to test if you are iterating over one of those values is silly code. # # What should have been done is to save the relevent query params to a + hash # and then process each param as needed, without employing the silly c +onditional # logic and synthetic $contentTemp variable # # I also can't imagine any circumstance in which having a (.*) to gobb +le up # the content in $content is a good thing. # open(HOME,">$fto"); # again, no error checks, and no locking.
       MeowChow                                   
                   s aamecha.s a..a\u$&owag.print
Re: How many bugs can *you* find
by turnstep (Parson) on May 01, 2001 at 01:47 UTC

    I started to rewrite it, just for fun, but I had to stop halfway through. Please tell us this is not production code being used somewhere. Please?

      turnstep wrote:

      Please tell us this is not production code being used somewhere. Please?

      Unfortunately, I can't tell you that. It is being used. It's in a script that is over 2,000 lines long and does not use strict. I added use strict and an extra 130 lines were added to the error log. As usual, I don't have a lot of time to fix this, and it's called from several different places. My only change at this point was to plug a nasty security that tinman alluded to:

      Umm.. a biggie, but I don't think you're untainting any of the file name variables or the param variables that you recieve from the user... so a script kiddie style "rm -rf" hack is possible..

      Cheers,
      Ovid

      Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

        Well, in that case, if you have to put up with 2000 lines, I can put up with these few. :)

        ## Implicit: htmDir no longer ends in a slash use strict; ## Yay!! sub updateTiles() { my $tilefile = "$htmDir/tile.htm"; open(TILE, "$tilefile") or die "Could not open $tilefile: $!\n"; my $tileinfo; { local $/; $tileinfo = <TILE>; } my $section; for $section (qw(Tile Pile Link)) { my $contentTemp = $query->param($section); ## Clean up, aisle seven $contentTemp =~ y/A-Za-z0-9_\n//cd; if ($section eq "Pile") { $contentTemp =~ s#\n#<P></P>#g; } elsif ($section eq "Link") { my $searchterm = $contentTemp; ## Even stricter here: $searchterm =~ y/a-z//cd; $contentTemp = qq{<IMG SRC="images/enter.gif" WIDTH="8" HEIGHT="12">}. qq{<A HREF="cgi-bin/show.cgi?action=showTiles&tileType=Search}. qq{&searchFor=$searchterm">View this month's tiles.</A>}; } ## Ugh...I am not going to touch this. $tileinfo =~ s/<!--$section-->(.*)/<!--$section-->$contentTemp/; } ## Should probably write a new file and copy/rename but: ## File locking anyone? :) open(HOME,">$tilefile") or die "Could not write $tilefile: $!\n"; print HOME $tileinfo; close(HOME); my $image = $query->param('Image'); if ($image =~ /^[A-Z0-9_]$/i) { my $newFile = &fileUpload('Image',250000,1,'latest_image', 'JPEG','.jpg','.jpeg'); } }

        Update: Thanks to merlyn for the catch with the brackets. Now fixed. $Deity help the rest of the 2000 lines however.

Re: How many bugs can *you* find
by buckaduck (Chaplain) on May 01, 2001 at 01:47 UTC
    • I don't know where $htmDir came from so it may be better to read from the file explicitly:  open (HOME, "<$fto") or die...;
    • $contentTemp should be escaped before being included in a URL.
    • If @sections is more complicated, you may need to \Q$section\E in the regex.

    buckaduck

Re: How many bugs can *you* find
by merlyn (Sage) on May 01, 2001 at 03:10 UTC
    OK, in five minutes, trying not to remember what anyone else said:
    sub updateTiles { my $fto = $htmDir . 'tile.htm'; ## global var used my $content = ''; open(HOME,$fto); ## no checking for return value, could have redirect or pipe opens while (<HOME>) { $content .= $_ } ## inefficient close(HOME); my $paramTemp,$contentTemp; ## $contentTemp is NOT BEING DECLARED LOCAL (very misleading) my @sections = qw(Tile Pile Link); foreach $section (@sections) { ## no declaration of $section $contentTemp = $query->param($section); ## use of global $query. Why is contentTemp not declared here? if ($section eq 'Pile') { $contentTemp =~ s/[\n\r]/<p> +/g; } if ($section eq 'Link') { $contentTemp = "<img src=\"i +mages/enter.gif\" width=8 height=12><a href=\"cgi-bin/show.cgi?action +=showTiles&tileType=Search&searchFor=$contentTemp\">View this month's + tiles.</a>" } ## ampersands not entitized, inserted content not entitized or escape +d $content =~ s/<!--$section-->(.*)/<!--$section-->$cont +entTemp/; ## parens not needed on .*, what if $section has regex chars? } open(HOME,">$fto"); ## no checking return values; what if $fto starts with >? print HOME $content; ## could get IO error. What if visitor hits page while partially writ +ten? close(HOME); ## could get IO error. my $image = $query->param('Image'); if ($image ne '') { my $newFile = fileUpload('Image',250000,1, +'latest_image','JPEG','.jpg','.jpeg') } ## image might be undef if param not provided. }
    This code is clearly not -w or strict compatible.

    See what you can get for $10 of my time? How many of those would you have found for $10 of your time? {grin}

    -- Randal L. Schwartz, Perl hacker

      New business idea: post code samples and try to get merlyn to offer free code reviews. Sell code reviews to clients...

      merlyn wrote:

      See what you can get for $10 of my time? How many of those would you have found for $10 of your time? {grin}

      Rather than list what I found, I'll list what I didn't. Then everyone can see what a faker I am :)

      my $paramTemp,$contentTemp; ## $contentTemp is NOT BEING DECLARED LOCAL (very misleading)

      Gah! I didn't see that one. (FYI: if you don't see it, "my" binds tighter than the comma).

      $content =~ s/<!--$section-->(.*)/<!--$section-->$contentTemp/; ## parens not needed on .*, what if $section has regex chars?

      Saw the useless parens (and that despicable dot star!), but didn't think about $section having regex characters.

      if ($image ne '') { my $newFile = fileUpload('Image',250000,1,'lat +est_image','JPEG','.jpg',' +.jpeg') } ## image might be undef if param not provided.

      Sigh. I missed this one, too.

      All in all, I don't feel bad about catching most of the errors. This little post was 17 lines of code. Imagine expanding this out to over 2,000!

      Cheers,
      Ovid

      Update: It's interesting to notice that someone can hack together a script that has virtually every line of code in error and have the script still work. The person who wrote this code was a coder, not a programmer.

      Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

        Said merlyn, and then Ovid:
        $content =~ s/<!--$section-->(.*)/<!--$section-->$contentTemp/; ## parens not needed on .*, what if $section has regex chars?
        Saw the useless parens (and that despicable dot star!), but didn't think about $section having regex characters.
        Actually, $section can't have regex characters as the code is written, since it simply iterates over the hard-coded items in @sections.

        That will be five dollars, please. I take paypal, and I don't take American Express.

           MeowChow                                   
                       s aamecha.s a..a\u$&owag.print
      Wow. By my calculations, that's $120 an hour. And yet, I'm tempted to scrape up some money, gather a bunch of my scripts together, and see what Randal can do with them in an hour...

      buckaduck

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://76754]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (16)
As of 2014-08-22 15:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (159 votes), past polls