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

Hi Monks,

A little while ago i posted a script that i wrote to take input from a form for you all to look at and comment on.
I think most of you came to the conclusion that the script was totaly insecure.
So, i've taken it back to base and re-wrote the whole thing.

Would you be able to take a look at it again for me, and tell me if it can be improved?
#!/usr/bin/perl -wT use CGI; use strict; # Set Variables my $w = new CGI; my $ip = $ENV{'REMOTE_ADDR'}; my $message = ""; my $found_err = ""; my $filenum = time.int rand 1000000; # Grab Input From Form my $username = $w->param('username'); my $domain = $w->param('domain'); my $email = $w->param('email'); my $service = $w->param('service'); my $conditions = $w->param('conditions'); # Begin Sanitising Input if ($username !~ /^[A-Za-z][-.\w]{2,29}$/) { $message = $message."<p>Error With Username. Please Retry</p>\ +n"; $found_err = 1; } if ($domain !~ m/^a.com|c.com|f.com|h.net|ho.com| |i.com|k.com|o.com|s.com|x.com$/) { $message = $message."<p>Error With Domain. Contact Support</p> +\n"; $found_err = 1; } if ($email !~ /^([a-zA-Z0-9_\.\-])+\@(([a-zA-Z0-9\-])+\.)+([a-zA-Z0-9] +)+$/i) { $message = $message."<p>Error With E-Mail Address. Please Retry</p +>\n"; $found_err = 1; } if ($service !~ m/^Yes|No$/) { $message = $message."<p>Error With Service. Contact Support</p +>\n"; $found_err = 1; } if ($conditions !~ m/^Yes$/) { $message = $message."<p>Please Accept The Terms And Conditions +</p>\n"; $found_err = 1; } if ($found_err) { &PrintError; } # Dump User Data To File open (LOGFILE, ">>/var/log/accounts/$filenum") or die $!; print LOGFILE "$username,$domain,$email,$service,$ip\n"; close (LOGFILE); # Display Html Completion print "Content-type: text/html\n\n"; print "Blah Blah, All Done\n"; # Display Error Messages sub PrintError { print "Content-type: text/html\n\n"; print $message; exit 0; return 1; }
Also note, that i am not too bothered about the e-mail address validation.
Thanks

Replies are listed 'Best First'.
Re: Peruse my code...
by BrowserUk (Patriarch) on Aug 31, 2002 at 12:22 UTC

    Two things stand out from a first pass look.

    $message = $message . "somemore"; is better (read: shorter, clearer) written as $message .= 'somemore';. Also, note, you save a little in compile time (load time) if you use 'text', rather than "text" for string constants as the compiler knows it doesn't have to check for things to interpolate.

    ++ for reporting all errors in one pass, not each one individually as so many damn sites do.

    I'm not quite sure why your sub PrintError has both exit 0; and return 1;. The latter will never be seen, and the former means that the script will abort after printing the error text, which maybe what you want, as otherwise the script would go on to say 'Blah Blah, All done'.$/;?

    I don't find it aesthetically pleasing to exit a program from within a sub that way. I doesn't make too much difference in a script this short, but as the script grows in size, its likely to become confusing to those poor souls that come along after to maintain your work.

    I think I would write that as

    if ($found_err) { &PrintError; exit -1; # 0 often means ok, whereas this is an error exit. }

    And remove the exit 0; from PrintError ... also the if your never going to check its value or if its always going to be the same, the return 1; serves little purpose.

    Finally (yes, I know that's more than two things:), by putting the } on the end of the last line of the if block makes it harder to add in statements. Putting it on the next line by itself, it can replace one of your blank lines, retains the value of the white space, clearly indicates where the block ends, and makes it easier to add statements in there. That's all a matter of taste, and often raises near religious ferver, so I'll add, IM(NS)HO! :)


    Well It's better than the Abottoire, but Yorkshire!
      cheers guys. that was most insightfull. All in all, it looks like only a few little things have to be done now. But, i am still stuck on what to do with the files once they have been wrote:

      I have tried but failed to create a script to descend into directory /var/log/accounts/ where there will be several hundred files (randomly named), pickup one of those files, open it and read the contents into variables. The file is arranged like the following 'username,domain,email,service'. Once it has read the contents in and run the code that i have created, it will then need to close that file, delete that file, and go round in a loop until no more files in that directory exist.

      I have asked before, but i am realy stuck and about to smack my head agains my monitor!

        I have tried but failed to create a script to descend into directory /var/log/accounts/ where there will be several hundred files (randomly named), pickup one of those files, open it and read the contents into variables. The file is arranged like the following 'username,domain,email,service'. Once it has read the contents in and run the code that i have created, it will then need to close that file, delete that file, and go round in a loop until no more files in that directory exist.

        Ok, ap3k, lets look at what you said.

        # ... descend into directory /var/log/accounts/... my $directory = '/var/log/accounts/'; opendir DIR, $directory or die $!.$/; # ... several hundred files ... my @files = readdir(DIR); closedir DIR or warn $!.$/; ... go round in a loop until no more files ... for my $file (@files) { # ... open it ... open FILE, $file or die $!.$/; # ... into variables ... username,domain,email,service ... my ( $username, $domain, $email, $service ) = split /,/, <FILE>; # ... read the contents ... # run the code that i have created #your code here! # ... close that file, ... close FILE or warn $!.$/; # ... delete that file ... unlink $file; } =cut

        That's (deliberatly) not perfect code. You will have to read the docs on readdir, split, open, unlink and probably grep, to get it to do something properly, but that will be a relief from abusing that poor monitor with your head!


        Well It's better than the Abottoire, but Yorkshire!
        This is what i have come up with so far, but it doesn't work. Any suggestions?
        #!/usr/bin/perl @file = `ls /var/log/accounts`; foreach $file { open(FILE, "<$file") || die; @account=<FILE>; close(FILE); foreach $account { ($username, $domain, $email, $service) = split(/,/, $account); # # Insert rest of my code here # } unlink $file; }
Re: Peruse my code...
by fruiture (Curate) on Aug 31, 2002 at 12:10 UTC

    Well, now all input is checked, but there are caveats about these checks. If some input fields are not given, you'll get warnings for undefined values. Also some Regexps are broken or inefficient. All in all, i'd write it like this:

    #!/usr/bin/perl -T use strict; use warnings; use CGI; my $w = new CGI; my $ip = $ENV{REMOTE_ADDR} || 'N/A'; my @errors = (); my $file = time.int rand 1_000_000; my %spec = ( username => qr#^[A-Za-z][-.\w]{2,29}$#, domain => qr#^(a|c|f|h|ho|i|k|o|s|x)\.com$#, email => qr#^[\w\.\-]+\@(?:[a-z\d\-]+\.)+[a-z\d]+$#i, service => qr#^Yes|No$#, conditions => qr#^Yes$#, ); my %fields; foreach( keys %spec ){ my $v = $w->param($_) or do { push @errors => "$_ not defined"; next }; $v =~ $spec{$_} or do { push @errors => "$_ invalid input"; next }; $fields{$_}=$v } print_error( @errors ) if @errors; open LOGFILE,'>>',"var/log/accounts/$file" or die "$file opening failed: $!"; print LOGFILE join(',',@fields{qw/username domain email service/},$ip) +,"\n"; close LOGFILE; print $w->header('text/plain'), "done"; sub print_error { print $w->header('text/plain'), @_; exit; }
    --
    http://fruiture.de

      Also some Regexps are broken or inefficient.

      my %spec = ( username => qr#^[A-Za-z][-.\w]{2,29}$#, domain => qr#^(a|c|f|h|ho|i|k|o|s|x)\.com$#, email => qr#^[\w\.\-]+\@(?:[a-z\d\-]+\.)+[a-z\d]+$#i, service => qr#^Yes|No$#, conditions => qr#^Yes$#, );

      These regexes allow for a newline after the last character. This could lead to trouble, for example when assuming your log file consists of one line with fields seperated by commas (as one probably would).

      The regex for domains assumes all domains are .com, which they are not. Apart from that, it can be written in a more efficient way.

      Your service regex is flawed: it allows for any string as long as it starts with Yes or ends with No (and optional newline).

      Also, there's no need to escape a dash (like you do in the email regex) if you put it at the beginning or end of a character class.

      In summary, I'd write those as:

      my %spec = ( username => qr/^ [A-Za-z] [-.\w]{2,29} \z/x, domain => qr/ ^h\.net\z | ^(?:ho | [acfikosx])\.com)\z /x, email => qr/^ [\w\.-]+ \@ (?:[a-z\d-]+\.)+ [a-z\d]+ \z/ix, service => qr/^(?:Yes|No)\z/, conditions => qr/^Yes\z/, );

      — Arien