DMS Example - Uploading

#!/usr/bin/perl -wT # upload.cgi use DBI; use strict; use File::Basename; use CGI qw(:standard); use CGI::Carp qw(fatalsToBrowser); require "./shared.pl" or die "Can't find file. $!\n"; my $user = Check_Cookie(); my $dbh = DB_Connect(); my $group = Get_Group($user); param('filename') ? Process_File() : Default_Page(); exit; sub Get_File_Name{ if($ENV{HTTP_USER_AGENT} =~ /win/i){ fileparse_set_fstype("MSDOS"); } elsif($ENV{HTTP_USER_AGENT} =~ /mac/i){ fileparse_set_fstype("MacOS"); } my $f_name = shift; $f_name = basename($f_name); $f_name =~ s!\s!\_!g; return($f_name); } sub UnTaint{ my $var = shift; if ($var =~ /^([-\@\w.]+)$/){ $var = $1; } else{ die "Filename is tainted!\n"; } return($var); } sub Process_File{ my $description = param('description'); my $file_name = param('filename'); my $area = param('area'); my $mime = uploadInfo($file_name)->{'Content-Type'}; my $path = "/usr/web/cgi-bin/data"; my $file = Get_File_Name($file_name); $area = UnTaint($area); $file = UnTaint($file); unless($mime){ $mime = "text/plain"; } my $ptr = Get_File_Info($file, $area); unless($ptr->{file_id}){ Upload_File ($file, $area, $mime, $description); Add_New_File($file, $area, $mime, $description); print redirect(-uri=>"main.cgi"); exit; } else{ unless($ptr->{who_to}){ print redirect(-uri=>"main.cgi"); exit; } else{ # File *is* checked out. if($ptr->{who_to} eq $user){ Upload_File ($file, $area, $mime, $description); Check_File_In($file, $area, $mime, $description); print redirect(-uri=>"main.cgi"); exit; } else{ print redirect (-uri=>"main.cgi"); exit; } } # end of unless..else } exit; } sub Check_File_In{ $dbh->do( " UPDATE TABLE dms_files SET (filename, group_id, mime_type, description, who_to, out_date) VALUES (?, ?, ?, ?, 'NULL', 'NULL') ", {}, (@_) ); } sub Add_New_File{ $dbh->do( " INSERT INTO dms_files (filename, group_id, mime_type, description) VALUES (?, ?, ?, ?) ", {}, (@_) ); } sub Upload_File{ my ($file, $area, $mime, $description) = @_; my $file_name = param('filename'); my $path = "/usr/web/cgi-bin/data"; my $data; ## Checks $file & area for taintedness. $area = UnTaint($area); $file = UnTaint($file); open(VAULT, ">$path/$area/$file") or die "Error opening file: $!\n"; unless($mime =~ /text/){ binmode ($file_name); binmode (VAULT); } while( read($file_name, $data, 1024) ){ print VAULT $data; } close VAULT; } sub Get_File_Info{ my ($file, $group) = @_; my $sth = $dbh->prepare( qq{ SELECT * FROM dms_files WHERE ((filename = ?) AND (group_id = ?)) } ); $sth->execute($file, $group); my $ptr = $sth->fetchrow_hashref; return($ptr); } sub Default_Page{ my $options; { $options = qq{ }; last if($group eq "PEON"); $options .= qq{ }; last if($group eq "USER"); $options .= qq{ }; last if($group eq "PHB"); $options .= qq{ }; } print header; print< DMS Example - Uploading HTML exit; }

Filename:
Area:
Description:

Welcome to the DMS Example - Uploading