NAME

Brick::File - This is the description

SYNOPSIS

DESCRIPTION

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

Utilities

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

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

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

CPAN RT