The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

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 in Github:

        https://github.com/briandfoy/brick

AUTHOR

brian d foy, <bdfoy@cpan.org>

COPYRIGHT

Copyright © 2007-2022, brian d foy <bdfoy@cpan.org>. All rights reserved.

You may redistribute this under the terms of the Artistic License 2.0.