brian d foy > Brick-0.226_02 > Brick::File

Download:
Brick-0.226_02.tar.gz

Annotate this POD

CPAN RT

New  3
Open  0
View/Report Bugs
Source  

NAME ^

Brick::File - This is the description

SYNOPSIS ^

see Brick

DESCRIPTION ^

See Brick::Constraints for the general discussion of constraint creation.

Utilities

is_mime_type( HASH_REF )

Passes if the file matches one of the listed MIME types.

        mime_types              array reference of possible MIME types
        file_field              the name of the file to check
has_file_extension( HASH_REF )

This constraint checks the filename against a list of extensions which are the elements of ARRAY_REF.

        field                   the name of the field holding the filename 
        extensions              an array reference of possible extensions
is_clamav_clean( HASH_REF )

Passes if ClamAV doesn't complain about the file.

        clamscan_location       the location of ClamAV, or /usr/local/bin/clamscan
        filename                        the filename to check

The filename can only contain word characters or a period.

sub file_clamav_clean { my $clamscan = "/usr/local/bin/clamscan";

    return sub {
        my $dfv = shift;
        $dfv->name_this('file_clamav_clean');
        my $q = $dfv->get_input_data;

        # Set $ENV{PATH} to the empty string to avoid taint error from
        # exec call. Use local to temporarily clear it out in the context
        # of this sub.
        local $ENV{PATH} = q{};


        $q->UNIVERSAL::can('param') or
            die 'valid_file_clamav_clean: data object missing param() method';

        my $field = $dfv->get_current_constraint_field;

        my $img = $q->upload($field);

        if (not $img and my $err = $q->cgi_error) {
            warn $err;
            return undef;
        }

        my $tmp_file = $q->tmpFileName($q->param($field)) or
            (warn "$0: can't find tmp file for field named $field"),
                return undef;

        ## now return true if $tmp_file is not a virus, false otherwise
        unless (-x $clamscan) {
            warn "$0: can't find clamscan, skipping test";
            return 1;                   # it's valid because we don't see it
        }

        defined (my $pid = open KID, "-|") or die "Can't fork: $!";
        unless ($pid) {               # child does:
            open STDIN, "<$tmp_file" or die "Cannot open $tmp_file for input: $!";
            exec $clamscan, qw(--no-summary -i --stdout -);
            die "Cannot find $clamscan: $!";
        }
        ## parent does:
        my $results = join '', <KID>;
        close KID;
        return if $results; ## if clamscan spoke, it's a virus

        return 1;
    };
}

TO DO ^

Regex::Common support

SEE ALSO ^

TBA

SOURCE AVAILABILITY ^

This source is part of a SourceForge project which always has the latest sources in CVS, as well as all of the previous releases.

        http://sourceforge.net/projects/brian-d-foy/

If, for some reason, I disappear from the world, one of the other members of the project can shepherd this module appropriately.

AUTHOR ^

brian d foy, <bdfoy@cpan.org>

COPYRIGHT ^

Copyright (c) 2007, brian d foy, All Rights Reserved.

You may redistribute this under the same terms as Perl itself.

syntax highlighting: