package Immutable;

use strict;
use warnings;

# XXX: Change this to your file system flags!
use constant EXT2_IOC_GETFLAGS => 0x80046601;
use constant EXT2_IOC_SETFLAGS => 0x40046602;
use constant EXT2_IMMUTABLE_FL => 16;
use constant EXT2_APPEND_FL    => 32;

# prototypes

sub is_immutable($);
sub set_immutable($);
sub unset_immutable($);
sub _get_attr($);
sub _set_attr($$);
sub set_immutable_recursive($);
sub unset_immutable_recursive($);

# procedures

sub is_immutable($) {
    my ($file) = @_;
    my $attr = _get_attr($file);
    return unless defined $attr;
    return $attr & EXT2_IMMUTABLE_FL;
}

sub set_immutable($) {
    my ($file) = @_;
    my $attr = _get_attr($file);
    return unless defined $attr;
    return _set_attr( $file, $attr | EXT2_IMMUTABLE_FL );
}

sub unset_immutable($) {
    my ($file) = @_;
    my $attr = _get_attr($file);
    return unless defined $attr;
    return _set_attr( $file, $attr & ~EXT2_IMMUTABLE_FL );
}

sub _get_attr($) {
    my ($file) = @_;
    my $attr = undef;
    if ( open FH, $file ) {
        my $res = pack 'i', 0;
        if ( ioctl( FH, EXT2_IOC_GETFLAGS, $res ) ) {
            $attr = unpack 'i', $res;
        }
        else {
            print "Failed to ioctl(FH, EXT2_IOC_GETFLAGS, res): $!\n";
        }
        close FH;
    }
    return $attr;
}

sub _set_attr($$) {
    my ( $file, $attr ) = @_;
    my $success = undef;
    if ( open FH, $file ) {
        $attr = pack 'i', $attr;
        if ( ioctl( FH, EXT2_IOC_SETFLAGS, $attr ) ) {
            $success = 'Ok';
        }
        else {
            print "Failed to ioctl(FH, EXT2_IOC_SETFLAGS, res): $!\n";
        }
        close FH;
    }
    return $success;
}

sub set_immutable_recursive($) {
    my ($path) = @_;

    return if -l $path;
    return unless -e $path;

    set_immutable($path) unless is_immutable($path);

    return if -f $path;

    if ( opendir( DIR, $path ) ) {
        my ( @all, @files, @dirs );

        @all = grep { !/^\.{1,2}$/ } readdir(DIR);
        close(DIR);

        $path =~ s|/+|/|g;
        $path =~ s|/$||;

        @all = map { $path . '/' . $_ } @all;    # remove "." and ".."
        @all = map { $_ if not -l $_ } @all;     # remove symlinks

        map { push @dirs,  $_ if -d $_ } @all;
        map { push @files, $_ if -f $_ } @all;

        foreach my $dir (@dirs) {
            if ( not is_immutable($dir) ) {
                set_immutable($dir);
            }
            set_immutable_recursive($dir);
        }

        foreach my $file (@files) {
            if ( not is_immutable($file) ) {
                set_immutable($file);
            }
        }
    }
    else {
        print "Failed to open path ($path) - $!\n";
    }
}

sub unset_immutable_recursive($) {
    my ($path) = @_;

    return if -l $path;
    return unless -e $path;

    if ( is_immutable($path) ) {
        unset_immutable($path);
    }

    return if -f $path;

    if ( opendir( DIR, $path ) ) {
        my ( @all, @files, @dirs );

        @all = grep { !/^\.{1,2}$/ } readdir(DIR);
        close(DIR);

        $path =~ s|/+|/|g;
        $path =~ s|/$||;

        @all = map { $path . '/' . $_ } @all;    # remove "." and ".."
        @all = map { $_ if not -l $_ } @all;     # remove symlinks

        map { push @dirs,  $_ if -d $_ } @all;
        map { push @files, $_ if -f $_ } @all;

        foreach my $dir (@dirs) {
            if ( is_immutable($dir) ) {
                unset_immutable($dir);
            }
            unset_immutable_recursive($dir);
        }

        foreach my $file (@files) {
            if ( is_immutable($file) ) {
                unset_immutable($file);
            }
        }
    }
    else {
        print "Failed to open path ($path) - $!\n";
    }
}

1;