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.