fattr.old

#!/usr/bin/env perl
use warnings;
use strict;
use open qw(:std :utf8);
use Getopt::Long qw(:config bundling no_ignore_case);
use MIME::Base64;
use Nullroute::Lib;

# https://freedesktop.org/wiki/CommonExtendedAttributes/

my %ALIAS_ATTRS = (
	author	 	=> "user.dublincore.creator",
	comment  	=> "user.xdg.comment",
	date	 	=> "user.dublincore.date",
	desc		=> "user.dublincore.description",
	description	=> "user.dublincore.description",
	lang     	=> "user.xdg.language",
	origin   	=> "user.xdg.origin.url",
	mime  		=> "user.mime_type",
	mimetype	=> "user.mime_type",
	publisher	=> "user.dublincore.publisher",
	referer  	=> "user.xdg.referrer.url",
	relation	=> "user.dublincore.relation",
	subject		=> "user.dublincore.subject",
	title	 	=> "user.dublincore.title",
);

my %HIDE_ATTRS = (
	"user.com.dropbox.attributes" => 1,
	"user.com.dropbox.attrs" => 1,
);

my %Opt = (
	all => 0,
);

sub _system {
	my (@args) = @_;
	_debug("running: @args");
	system {$args[0]} @args;
}

sub escape_c {
	my ($str) = @_;
	$str =~ s/[\\"]/\\$&/g;
	$str =~ s/\n/\\n/g;
	$str =~ s/\t/\\t/g;
	$str =~ s/[\x00-\x1F]/sprintf("\\x%02X", ord($&))/ge;
	return $str;
}

sub safe_val {
	my ($str) = @_;
	if (utf8::is_utf8($str) || utf8::decode($str)) {
		return "\"".escape_c($str)."\"";
	} else {
		return "{".encode_base64($str, "")."}";
	}
}

sub format_val {
	my ($key, $str) = @_;

	if ($key eq "DOSATTRIB") {
		my @out;
		my ($attrib_hex, $version, $rest) = unpack("Z* S> a*", $str);
		if ($attrib_hex =~ /^0x([0-9A-F]+)$/) {
			my $bits = hex $1;
			my $attrib = "";
			if ($bits & 0x01) { $attrib .= "R"; }
			if ($bits & 0x02) { $attrib .= "H"; }
			if ($bits & 0x04) { $attrib .= "S"; }
			if ($bits & 0x20) { $attrib .= "A"; }
			push @out, "attrib=".safe_val($attrib);
		}
		push @out, "version=".safe_val($version);
		push @out, "rest=".safe_val($rest);
		#return safe_val($str)." "."{@out}";
	}
	return safe_val($str);
}

sub linux_get_attrs_batch {
	my (@files) = @_;
	my %results;
	if (open(my $fh, "-|",
			"getfattr", "--dump",
			$Opt{all} ? "--match=.*" : "--match=^user\\.",
			"--encoding=base64",
			"--absolute-names",
			"--", @files))
	{
		my ($file, $key, $val);
		while (<$fh>) {
			if (/^# file: (.+)$/) {
				$file = $1;
				$results{$file} = {};
			}
			elsif (/^$/) {
				$file = undef;
			}
			elsif (/^(.+?)=0s(.*)$/) {
				$key = $1;
				$val = decode_base64($2);
				$results{$file}{$key} = $val;
			}
			else {
				_die("BUG: getfattr returned unparsable line: $_");
			}
		}
		close($fh);
	}
	return %results;
}

sub set_attrs {
	my ($key, $val, @files) = @_;
	my $ret = _system("setfattr", "-n", $key, "-v", $val, "--", @files);
	return ($ret > 0);
}

sub unset_attrs {
	my ($key, @files) = @_;
	my $ret = _system("setfattr", "-x", $key, "--", @files);
	return ($ret > 0);
}

sub _show_file_attrs {
	my ($file, $attrs, $keys) = @_;
	print "\e[1m".$file."\e[m\n";
	if (!@$keys) {
		print "  \e[2m-- no attributes --\e[m\n";
	}
	for my $key (sort @$keys) {
		my $val = $attrs->{$key} // next;
		$key =~ s/^user\.// unless ($Opt{all} >= 2);
		print "  ".$key." = ".format_val($key, $val)."\n";
	}
	print "\n";
}

my $read_fattrs_batch;
my $read_fattrs;
my $list_fattrs;
my $read_fattr;
my $write_fattr;

if (eval {require File::ExtAttr}) {
	_debug("using File::ExtAttr");

	$list_fattrs = sub {
		my ($path) = @_;
		my @keys = ();
		$! = undef;
		my @namespaces = File::ExtAttr::listfattrns($path);
		return if $!;
		for my $ns (@namespaces) {
			$! = undef;
			my @nskeys = File::ExtAttr::listfattr($path, {namespace => $ns});
			return if $!;
			push @keys, map {"$ns.$_"} @nskeys;
		}
		return @keys;
	};
	$read_fattr = sub {
		my ($path, $attr) = @_;
		my ($ns, $tail) = split(/\./, $attr, 2);
		$! = undef;
		my $val = File::ExtAttr::getfattr($path, $tail, {namespace => $ns});
		return if $!;
		return $val;
	};
}
elsif (eval {require Linux::UserXAttr}) {
	_debug("File::ExtAttr missing; falling back to Linux::UserXAttr");

	$list_fattrs = sub {
		my ($path) = @_;
		my @keys = Linux::UserXAttr::listxattr($path);
		return @keys;
	};
	$read_fattr = sub {
		my ($path, $attr) = @_;
		my $value = Linux::UserXAttr::getxattr($path, $attr);
		return $value;
	};
}
else {
	_notice("File::ExtAttr missing; falling back to getfattr");

	$read_fattrs = sub {
		my ($path) = @_;
		my @cmd = ("getfattr", "--dump", "--match=.*", "--encoding=base64", "--absolute-names");
		my %attrs;
		if (open(my $fh, "-|", @cmd, "--", $path)) {
			my ($file, $key, $val);
			while (<$fh>) {
				if (/^# file: (.+)$/) {
					$file = $1;
					%attrs = ();
				} elsif (/^$/) {
					$file = undef;
				} elsif (/^(.+?)=0s(.*)$/) {
					$key = $1;
					$val = decode_base64($2);
					$attrs{$key} = $val;
				} else {
					die("BUG: getfattr returned unparsable line: $_");
				}
			}
			close($fh);
		} else {
			die("fork getfattr failed");
		}
		return %attrs;
	};

	$read_fattrs_batch = sub {
		my (@paths) = @_;
		return linux_get_attrs_batch(@paths);
	};
}

sub dump_attrs {
	my (@files) = @_;
	my $ret = 0;

	if ($read_fattrs_batch) {
		my %all_attrs = $read_fattrs_batch->(@files);
		for my $file (@files) {
			my $attrs = $all_attrs{$file};
			my @keys = keys %$attrs;
			unless ($Opt{all}) {
				@keys = grep {/^user\./} @keys;
				@keys = grep {!$HIDE_ATTRS{$_}} @keys;
			}
			unless ($Opt{all} || $Opt{empty}) {
				next if !@keys;
			}
			_show_file_attrs($file, $attrs, \@keys);
		}
	}
	elsif ($list_fattrs && $read_fattr) {
		for my $file (@files) {
			my @keys = $list_fattrs->($file);
			if ($!) {
				_err("cannot list attrs of '$file': $!");
				++$ret; next;
			}
			unless ($Opt{all}) {
				@keys = grep {/^user\./} @keys;
				@keys = grep {!$HIDE_ATTRS{$_}} @keys;
			}
			unless ($Opt{all} || $Opt{empty}) {
				next if !@keys;
			}
			my %attrs;
			for my $key (@keys) {
				$attrs{$key} = $read_fattr->($file, $key);
				if ($!) {
					_err("cannot read attr '$key' of '$file': $!");
					++$ret;
				}
			}
			_show_file_attrs($file, \%attrs, \@keys);
		}
	}
	else {
		die("no implementation");
	}
	return ($ret > 0);
}

sub usage {
	print "$_\n" for
	"Usage: $::arg0 [-a] PATH... [KEY=VALUE...]",
	"",                           #
	"  -a, --all                  include non-user namespaces",
	"  PATH                       file names to examine/modify",
	"  KEY=VALUE                  extended attributes to set",
	"                             (empty value will remove attribute)",
}

utf8::decode($_) for @ARGV;

GetOptions(
	"help" => sub { usage(); exit; },
	"a|all+" => \$Opt{all},
	"e|empty!" => \$Opt{empty},
) or exit(2);

my %attrs;
my @files;

my $attr_re = qr|[^/?=]+|;

for (@ARGV) {
	if (-e $_ || -l $_) {
		push @files, $_;
	}
	elsif (/^($attr_re)=(.*)$/) {
		my ($key, $val) = ($1, $2);
		if ($ALIAS_ATTRS{$key}) {
			$key = $ALIAS_ATTRS{$key};
		} elsif ($key =~ /^\./) {
			$key =~ s///;
		} elsif ($key !~ /^(user|system|security|trusted)\./) {
			$key = "user.".$key;
		}
		$attrs{$key} = $val;
	}
	else {
		push @files, $_;
	}
}

if (!@files) {
	_die("no files specified");
}

my $exit = 0;

if (%attrs) {
	for my $key (keys %attrs) {
		my $val = $attrs{$key};
		if (length $val) {
			_debug("setting '$key' to '$val'");
			$exit |= set_attrs($key, $val, @files);
		} else {
			_debug("removing '$key'");
			$exit |= unset_attrs($key, @files);
		}
	}
} else {
	$exit |= dump_attrs(@files);
}

exit $exit;