Category: | CGI Programming |
Author/Contact Info | Adam Monsen <meonkeys@hotmail.com> |
Description: | The attached code is a CGI that allows someone to maintain the CSV used to generate a Web site for the University of Washington Men's Water Polo team. I seek help, comments, and criticism on: 1)security, 2)speed, 3)the general approach of using a CSV-driven Web site, 4)anything blatanly wrong or stupid, 5)other cool ways to do what I'm doing. My main goal was maintainability. It was easy for me to teach my Polo coach how to update CSV files, and CSV is relatively easy to deal with for the CGI. I would REALLY appreciate feedback on the entire Web site (two CGIs and a few packages), as well. The entire codebase is viewable: every file has a ".txt" added to the end. The code_review/ dir is analagous to the document root for the actual working Web site. The main CGI is in "code_review/", Perl modules are in "code_review/myperl/", the CSV updating tool is in "code_review/admin/", and the CSV datafiles are in "code_review/data/". codebase |
#!/usr/local/bin/perl -Tw # Please see entire codebase for this Web site at # http://students.washington.edu/dawgpolo/code_review/ # Pre-live checklist: # [X] add some file locking for Godsakes!!! # [X] link to this thing and do auth ONLY through SSL!! # [X] protect /admin dir with .htaccess # [X] use $ENV{ REMOTE_USER } once .htaccess is in place # [X] make sure to untaint $ENV{ REMOTE_USER } # [X] write a file-storing routine ... just did it inline instead # [X] bonus points: use XML :) # [X] app tempfiles? # [X] move to "live" data dir automatically? # [X] add CSV validation to _validate_upload # [X] test CSV validation to _validate_upload # [X] count fields in a cool way for $num_fields use lib '/dw02/d37/dawgpolo/myperl'; use lib '/dw02/d37/dawgpolo/myperl/lib'; use CGI; use CGI::Carp qw( fatalsToBrowser ); # I think this slows us down use Data::Dumper; use Date::Format; use Dawg qw( %CONFIG %CSV ); use Dawg::DB; use Dawg::Draw; use Fcntl qw( :flock ); use strict; $ENV{ HTTPS } or die "Insecure! Change URL to https://$ENV{ HTTP_HOST +}". "$ENV{ SCRIPT_NAME }\n"; $ENV{ HTTPS } =~ tr/A-Za-z//cd; $ENV{ SERVER_ADMIN } = $CONFIG{ EMAIL }; $ENV{ PATH } = '/usr/local/bin:/usr/bin:/bin'; my $cgi = CGI->new; my $draw = Dawg::Draw->new; my $title = 'CSV Update Tool'; my $self = $ENV{ SCRIPT_NAME }; my $user = $ENV{ REMOTE_USER }; $user =~ tr/A-Za-z//cd; my $userIP = $ENV{ REMOTE_ADDR }; sub main { my %dispatch = ( upload => \&upload, debug => \&debug, DEFAULT => \&upload, ); $draw->headers(); $draw->html_start( { title => $title } ); my $action = $cgi->param('action') || 'DEFAULT'; my $do_sub = $dispatch{ $action }; if ( $do_sub ) { &$do_sub(); } else { warn "[warn] Invalid action: [$action]"; die "[die] You can't make me do that!\n"; } $draw->html_end(); } sub upload { my @errors = (); # array of errors found during execution my @lines = (); # input lines of uploaded file my $page = ''; # page that uploaded file corresponds to my $ucpage = ''; # uppercased version of the same thang my $mode = $cgi->param( 'mode' ); $mode =~ tr#a-z_##cd; # untaint that pa +ram! my $in = $cgi->upload( 'datafile_in' ); # returns a fileh +andle my $logfile = "$CONFIG{ ADMIN }/transactions.log"; # log entire tran +saction my $qwiklog = "$CONFIG{ ADMIN }/quicklog.csv"; # abbreviated log open( LOG, ">> $logfile" ) or die "Couldn't open $logfile"; open( QWK, ">> $qwiklog" ) or die "Couldn't open $qwiklog"; if ( $mode ) { # They're trying to upload a file push @errors, "Invalid filename" unless ( ref $in eq 'Fh' ); # retrieve the uploaded file and check for data integrity unless ( @errors ) { my $rv = Dawg::DB->slurp_csv_safe( $in ); if ( $rv ) { @lines = @$rv; } else { die "No lines returned while slurping CSV"; } if ( $mode =~ /^([a-z_]+)_go$/ ) { $page = $1 or die "no page given!"; $ucpage = uc($page); die "unknown page [$ucpage]" unless ( exists $CSV{$ucpage} ); my $result = Dawg::DB->validate_csv( $ucpage, \@lines ); @errors = @$result unless $result == 1; } } if ( @errors ) { print qq[ <FONT COLOR="RED">ERRORS OCCURRED DURING FILE UPLOAD:\ +n<BR> ]; print qq[ <UL>\n ]; foreach my $error ( @errors ) { print "<LI>$error\n"; } print qq[ </UL></FONT>\n ]; } else { # upload was good. my $time = time2str( "%C", time() ); my $outfile = "$CONFIG{DATA}/$page.csv" or die "cannot draft datafile filename for [$page]"; open( CSV, "> $outfile" ) or die "Couldn't open $outfile"; print qq[ <FONT COLOR="GREEN">$ucpage UPLOAD SUCCESSFUL</FONT><B +R>\n ]; # - 1 - lock all files to be written to flock( CSV, LOCK_EX|LOCK_NB ) or die "Can't lock CSV"; flock( LOG, LOCK_EX|LOCK_NB ) or die "Can't lock LOG"; flock( QWK, LOCK_EX|LOCK_NB ) or die "Can't lock QWK"; # - 2 - write the datafile itself for (@lines) { print CSV "$_\n" } # write csv to datafile # - 3 - write the entire transaction print LOG "[ $time ] $ucpage UPDATED by $user [$userIP]\n"; for (@lines) { print LOG "$_\n" } # log the transaction # - 4 - write a "qwiklog" entry print QWK "[ $time ] $ucpage UPDATED by $user [$userIP]\n"; # - 5 - close all filehandles, drop locks close( CSV ) or die "Couldn't close file $outfile"; close( LOG ) or die "Couldn't close file $logfile"; close( QWK ) or die "Couldn't close file $qwiklog"; flock( CSV, LOCK_UN ) or warn "Can't lock CSV"; flock( LOG, LOCK_UN ) or warn "Can't lock LOG"; flock( QWK, LOCK_UN ) or warn "Can't lock QWK"; } } else { # They're not trying to upload a file YET, so give them tips print <<End_HTML; Hints:<BR> <UL> <LI>Make sure the uploaded file is TRUE CSV, eg. blah,1,2,"blow, joe" <LI>Click the respective Upload button once, then <EM>wait</EM> <LI>You can only upload one file at a time </UL> End_HTML } foreach my $table ( sort keys %CSV ) { my $name = lc($table); print <<UploadForms; <BR> Download <A HREF="$CONFIG{ WEBDATA }/$name.csv">$name</A> datafile <FORM ACTION="$self" METHOD="POST" ENCTYPE="multipart/form-data"> <INPUT TYPE="FILE" NAME="datafile_in" SIZE="50" MAXLENGTH="80"> <BR> <INPUT TYPE="SUBMIT" VALUE="Upload $name"> <INPUT TYPE="HIDDEN" NAME="mode" VALUE="${name}_go"> </FORM> <BR> UploadForms } } sub debug { print "<PRE>\n"; print Data::Dumper->Dump( [\%ENV], ['ENV'] ); print "</PRE>\n"; } main(); |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Code review, good 'ol CGI.
by tachyon (Chancellor) on Jul 29, 2001 at 11:26 UTC | |
by meonkeys (Chaplain) on Jul 30, 2001 at 05:05 UTC | |
Re: Code review, good 'ol CGI.
by seanbo (Chaplain) on Jul 29, 2001 at 19:59 UTC | |
Re: Code review, good 'ol CGI.
by DBX (Pilgrim) on Jul 31, 2001 at 10:12 UTC | |
Re: Code review, good 'ol CGI.
by kschwab (Vicar) on Jul 29, 2001 at 09:26 UTC |
Back to
Code Catacombs