Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
################################ package CGI::Safe; ################################ $VERSION = 1.0; use strict; use Carp; use CGI; use Exporter; use vars qw/ @ISA @EXPORT_OK/; @ISA = qw/ CGI Exporter /; @EXPORT_OK = qw/ get_upload /; INIT { # Establish some defaults delete @ENV{ qw/ IFS CDPATH ENV BASH_ENV / }; # Clean up our Envir +onment $CGI::DISABLE_UPLOADS = 1; # Disable uploads $CGI::POST_MAX = 512 * 1024; # limit posts to 512 +K max } sub new { my ( $self, %args ) = @_; $CGI::DISABLE_UPLOADS = $args{ DISABLE_UPLOADS } if exists $args{ +DISABLE_UPLOADS }; $CGI::POST_MAX = $args{ POST_MAX } if exists $args{ +POST_MAX }; return ( exists $args{ source } ) ? CGI::new( $self, $args{ source + } ) : CGI::new( $self ); } sub get_upload { my $self; $self = shift if ref $_[0]; # can be tossed because hash keys can' +t be refs # this will occur if called in OO fash +ion my %specs = @_; if ( ! exists $specs{ cgi } ) { if ( defined $self ) { $specs{ cgi } = $self; } else { # Here, we're holding our breath and praying this doesn't +break in future releases. # uses objects internally, even if called through t +he functional interface. # self_or_default returns that object $specs{ cgi } = &CGI::self_or_default; } } # if the cgi value is not a reference and not a cgi object ... # This should *not* occur if ( ! ( ref $specs{ cgi } and $specs{ cgi }->isa( 'CGI' ) ) ) { croak '"cgi => $cgi_obj": The \'cgi\' value was not a CGI obje +ct'; } croak '&get_upload expects a hash with "file_name => $file_name"' +unless exists $specs{ file_name }; my %data = ( error => 0, file => undef, format => undef ); # Not using CGI::upload as I've had (and seen) problems with vario +us versions of this my $fh = $specs{ cgi }->param( $specs{ file_name } ); if ( $specs{ cgi }->cgi_error ) { $data{ error } = 'Error uploading file: ' . $specs{ cgi }->cgi +_error; return \%data; } if ( ! defined $fh ) { $data{ error } = 'No file uploaded.'; carp "No file uploaded. Did you remember 'enctype=\"multipart +/form-data\"' in your <form> tag?"; if ( $CGI::DISABLE_UPLOADS ) { carp "\$CGI::DISABLE_UPLOADS is set to $CGI::DISABLE_UPLOA +DS. This may be why no file was uploaded." } return \%data; } $data{ format } = $specs{ cgi }->uploadInfo( $fh )->{ 'Content-Typ +e' }; if ( exists $specs{ format } ) { my @format = ref $specs{ format } eq 'ARRAY' ? @{ $specs{ form +at } } : $specs{ form +at } ; my $re_format = quotemeta $data{ format }; if ( ! grep { /$re_format/ } @format ) { my $formats = ref $specs{ format } eq 'ARRAY' ? join ' or +', @{ $specs{ format } } : + $specs{ format } ; $data{ error } = "Illegal file format: $data{ format }. E +xpecting: $formats."; return \%data; } } binmode $fh; my $file = ''; binmode $file; { my $data = ''; while ( read( $fh, $data, 1024 ) ) { $file .= $data; } } if ( ! $file ) { $data{ error } = 'No file uploaded.'; return \%data; } $data{ file } = $file; return \%data; } "Ovid"; __END__ =head1 NAME CGI::Safe - Safe method of using This is pretty much a two-li +ne change for most CGI scripts. =head1 SYNOPSIS use CGI::Safe; my $q = CGI::Safe->new(); =head1 DESCRIPTION If you've been working with for any length of time, you know th +at it allows uploads by default and does not have a maximum post size. Since it sav +es the uploads as a temp file, someone can simply upload enough data to fill up your +hard drive to initiate a DOS attack. To prevent this, we're regularly warned to incl +ude the following two lines at the top of our CGI scripts: $CGI::DISABLE_UPLOADS = 1; # Disable uploads $CGI::POST_MAX = 512 * 1024; # limit posts to 512K max As long as those are their before you instantiate a CGI object (or bef +ore you access param and related CGI functions with the function oriented interface), + you have pretty safely plugged this problem. However, most CGI scripts don't have thes +e lines of code. Some suggest changing these settings directly in I dislike thi +s for two reasons: 1. If you upgrade, you might forget to make the change to the +new version. 2. You may break a lot of existing code (which may or may not be a go +od thing depending upon the security implications). Hence, the C<CGI::Safe> module. It will establish the defaults for th +ose variables and require virtually no code changes. Additionally, it will delete C<%EN +V> variables listed in C<perlsec> as dangerous. =head1 Objects vs. Functions Some people prefer the object oriented interface for and others + prefer the function oriented interface. Naturally, the C<CGI::Safe> module allows both. +There is also a C<CGI::Safe::get_upload> function that can be imported or used in OO f +ashion. use CGI::Safe; my $q = CGI::Safe->new( DISABLE_UPLOADS = 0 ); my $file = $q->get_upload( file_name => 'somefilename' ); Or: use CGI::Safe qw/ :standard get_upload /; $CGI::DISABLE_UPLOADS = 0; my $file = get_upload( file_name => 'somefilename' ); =head1 Uploads and Maximum post size As mentioned earlier, most scripts that do not need uploading should h +ave something like the following at the start of their code to disable uploads: $CGI::DISABLE_UPLOADS = 1; # Disable uploads $CGI::POST_MAX = 512 * 1024; # limit posts to 512K max The C<CGI::Safe> sets these values in an C<INIT{}> block. If necessar +y, the programmer can override these values two different ways. When using the function ori +ented interface, if needing file uploads and wanting to allow up to a 1 megabyte upload, they woul +d set these values directly I<before> using C<CGI::Safe::get_upload> or using any of the CG +I functions: use CGI::Safe qw/ :standard get_upload /; $CGI::DISABLE_UPLOADS = 0; $CGI::POST_MAX = 1_024 * 1_024; # limit posts to 1 meg max my $file = get_upload( file_name => 'somefilename' ); If using the OO interface, you can set these explicitly I<or> pass the +m as parameters to the C<CGI::Safe> constructor: use CGI::Safe; my $q = CGI::Safe->new( DISABLE_UPLOADS = 0, POST_MAX = 1_024 * 1_024 ); my $file = $q->get_upload( file_name => 'somefilename' ); =head1 objects from input files and other sources You can instantiate a new object from an input file, properly f +ormatted query string passed directly to the object, or even a has with name value pairs representi +ng the query string. To use this functionality with the C<CGI::Safe> module, pass this extra i +nformation in the C<source> key: use CGI::Safe; my $q = CGI::Safe->new( source = $some_file_handle ); Alternatively: use CGI::Safe; my $q = CGI::Safe->new( source => 'color=red&name=Ovid' ); =head1 File uploading This is not really necessary in the C<CGI::Safe> module, but it is inc +luded as many, many programmers have difficulty with this. C<CGI::Safe::get_upload> has takes three n +amed parameters (e.g. pass it a hash), two of which are optional. =over 4 =item 1 I<file_name> This specifies the name of the file in the "file" field of the of the +form. =item 2 I<format> This parameter is optional. Pass it a scalar with an allowed file typ +e or a list reference with multiple allowed file types. If the uploaded file doesn't match one of the sup +plied types, will return an error. By leaving this parameter off, C<CGI::Safe::get_upload> will return an +y type of file. =item 3 I<cgi> If, for some reason, you are using multiple CGI objects, you can speci +fy the CGI object which has the file in question. This parameter is also optional. It should seldom, if e +ver, be used. =back =head2 Using file uploading Basic use: use CGI::Safe; my $q = CGI::Safe->new( DISABLE_UPLOADS => 0 ); my $file = $q->get_upload( file_name => 'somefilename' ); Here's an example with all parameters specified: use CGI::Safe; my $q = CGI::Safe->new( DISABLE_UPLOADS => 0 ); my $file = $q->get_upload( file_name => 'somefilename', format => [ 'image/gif', 'image/jpeg' ] +, cgi => $cgi ); # use this only if yo +u have another cgi object instantiated # and it has the uplo +ad data that you need =head2 Return value from uploading C<CGI::Safe::get_upload> returns a scalar with a reference to an anony +mous has with three keys: =over 4 =item 1 error This key will contain a human readable error message that will explain + why the upload didn't succeed. It's value will be 0 (zero) if the upload was successful. =item 2 file This will be the actual contents of the file. =item 3 format This is the "content-type" of the file in question. For example, a GI +F file will have a format of 'image/gif'. =back =head2 Using the return values from uploading use CGI::Safe; my $q = CGI::Safe->new( DISABLE_UPLOADS => 0 ); my $file = $q->get_upload( file_name => 'somefilename' ); if ( $file->{ error } ) { print $q->header, $q->start_html, $q->p( $file->{ error } ), $q->end_html; } else { print $q->header( -type => $file->{ format } ), $file->{ file }; } =head1 COPYRIGHT Copyright (c) 2001 Curtis A. Poe. All rights reserved. This program is free software; you may redistribute it and/or modify i +t under the same terms as Perl itself =head1 AUTHOR Curtis A. Poe <> Address bug reports and comments to: When sending bug + reports, please provide the version of, the version of CGI::Safe, the ve +rsion of Perl, and the version of the operating system you are using. =head1 BUGS 2001/07/13 There are no known bugs at this time. However, I am somewh +at concerned about the use of this module with the function oriented interface. CG uses objects internally, even when using the function oriented interface (w +hich is part of the reason why the function oriented interface is not faster than t +he OO version). In order for me to determine the file object, I took a short cut and u +sed the C<CGI::self_or_default> method to capture that object. This simplifie +s my code, but it's possible that some versions of do not use this. If that i +s the case, I will need to pull the appropriate methods from the callers namespace ( +maybe) to get access to the uploaded file. =cut

In reply to CGI::Safe and easy file uploading by Ovid

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2024-04-17 06:21 GMT
Find Nodes?
    Voting Booth?

    No recent polls found