view release on metacpan or  search on metacpan

lib/Csistck/Test/FileBase.pm  view on Meta::CPAN

    $ret &= $self->uid_process(\&uid_repair);
    $ret &= $self->gid_process(\&gid_repair);
    
    return (($ret == 1) ? $self->pass('File repaired') :
      $self->fail('File not repaired'));
}

# Diff for files
sub diff {
    my $self = shift;
    
    die("Destination file does not exist: dest=<${\$self->dest}>")
      unless (-f -e -r $self->dest);
    
    # If we defined a source file
    if (defined($self->src) and $self->can('file_diff')) {
        $self->file_diff();
    }

    # TODO mode, uid, gid diff functions
}

# Wrapper functions to perform sanity tests on arguments
# Return pass if arguments are missing, die if invalid
sub mode_process {
    my ($self, $func) = @_;

    return 1 unless($self->mode);
    my $mode = $self->mode;
    die("Invalid file mode")
      if ($mode !~ m/^[0-7]{3,4}$/);
    $mode =~ s/^([0-7]{3})$/0$1/;
    $self->{mode} = $mode;
    
    &{$func}($self->dest, $self->mode);
}

sub uid_process {
    my ($self, $func) = @_;

    return 1 unless ($self->uid);
    die("Invalid user id")
      if ($self->uid !~ m/^[0-9]+$/);
    
    &{$func}($self->dest, $self->uid);
}

sub gid_process {
    my ($self, $func) = @_;

    return 1 unless ($self->gid);
    die("Invalid group id")
      if ($self->gid !~ m/^[0-9]+$/);

    &{$func}($self->dest, $self->gid);
}

# Mode operations
sub mode_check {
    my ($file, $mode) = @_;
    my $fh = stat($file);
    if ($fh) {
        my $curmode = sprintf "%04o", $fh->mode & 07777;
        debug("File mode: file=<$file> mode=<$curmode>");
        return 1 if ($curmode eq $mode);
    }
}

sub mode_repair {
    my ($file, $mode) = @_;
    debug("Chmod file: file=<$file> mode=<$mode>");
    chmod(oct($mode), $file);
}

# UID operations
sub uid_check {
    my ($file, $uid) = @_;
    my $fh = stat($file);
    my $curuid = undef;
    if ($fh) {
        my $curuid = $fh->uid;
        debug("File owner: file=<$file> uid=<$uid>");
    }
    return ($curuid == $uid);
}

sub uid_repair {
    my ($file, $uid) = @_;
    debug("Chown file: file=<$file> uid=<$uid>");
    chown($uid, -1, $file);
}

# GID operations
sub gid_check {
    my ($file, $gid) = @_;
    my $fh = stat($file);
    my $curgid = undef;
    if ($fh) {
        $curgid = $fh->gid;
        debug("File group: file=<$file> gid=<$gid>");
    }
    return ($curgid == $gid);
}

sub gid_repair {
    my ($file, $gid) = @_;
    debug("Chown file: file=<$file> gid=<$gid>");
    chown(-1, $gid, $file);
}

# Compare hashes between two files
sub file_compare {
    my @files = @_;
    return 0 unless (scalar @files == 2);
    
    # Get hashes and return compare
    my ($hasha, $hashb) = map hash_file($_), @files;
    debug(sprintf "File compare result: <hash=%s> <hash=%s>", $hasha, $hashb);
    return ($hasha eq $hashb);
}

1;