#!/usr/bin/env perl
# trash -- move files into XDG Trash
use v5.10;
use warnings;
use strict;
use Cwd qw(realpath);
use Errno qw(:POSIX);
use Fcntl;
use File::Basename qw(basename dirname);
use File::Path qw(make_path);
use File::Spec::Functions;
use Getopt::Long qw(:config bundling no_ignore_case);
use Nullroute::Lib;
use POSIX qw(strftime);

my $quiet = 0;
my $verbose = 1;
my $interactive = 0;
my $count = 0;

sub confirm {
	print "$::arg0: @_ "; $|++; <STDIN> =~ /^y/i;
}

sub dev {
	my ($path, $fatal) = @_;

	my @stat = lstat($path);
	if ($fatal && !@stat) {
		_die("could not stat '$path': $!");
	}
	return $stat[0];
}

sub in_path {
	my ($exe) = @_;

	grep {-f && -x}
	map {"$_/$exe"}
	map {$_ || "."}
	split(/:/, $ENV{PATH});
}

=item path_encode($str)

URL-encode the given path.

=cut

sub path_encode {
	my ($str) = @_;

	# RFC 2396 section 2 (mostly)
	$str =~ s/[^A-Za-z0-9_.!~*'();?:@&=+,\/-]/sprintf("%%%02X", ord($&))/seg;
	return $str;
}

=item path_decode($str)

URL-decode the given string.

=cut

sub path_decode {
	my ($str) = @_;

	$str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/seg;
	return $str;
}

=item my_abs_path($path)

Canonicalize symlinks and relative paths.
If $path itself is a symlink, do not canonicalize it.

=cut

sub my_abs_path {
	my ($path) = @_;
	my $b = basename($path);
	my $d = dirname($path);
	my $rd = realpath($d);
	_debug("abs: dir='$d' realdir='$rd' base='$b'");
	return $rd."/".$b;
}

=item abs2rel_down($path)

Convert path to relative, but only if under the given base.

=cut

sub abs2rel_down {
	my ($path, $base) = @_;
	my $rp = File::Spec->abs2rel($path, $base);
	return ($rp =~ /^\.\.\//) ? $path : $rp;
}

=item find_root($abs_path)

Find the root directory of the filesystem $path is in.

Does not currently work with bind-mounted files; returns the mountpoint's parent.

=cut

sub find_root {
	my ($path) = @_;
	_debug("finding root for '$path'");
	my $fdev = dev($path);
	return undef if !defined $fdev;
	my $prev = $path;
	while ($path ne "/") {
		$prev = $path;
		$path = dirname($path);
		return $prev if dev($path) != $fdev;
	}
	return $path;
}

=item ensure($trash_dir)

Recursively mkdir $trash_dir/{files,info} if necessary.

=cut

sub ensure {
	my ($trash_dir) = @_;
	_debug("preparing trash directory '$trash_dir'");
	for ($trash_dir, "$trash_dir/info", "$trash_dir/files") {
		next     if -d $_;
		return 0 if -e $_;
		_debug("- creating '$_'");
		make_path($_, {mode => 0700}) or return 0;
	}
	return 1;
}

=item xdev_move($source, $dest) -> $success

Copy a file or directory $source to $dest recursively and delete the originals.

=cut

sub xdev_move {
	my ($source, $dest) = @_;
	my @opt;
	_debug("xdev_move: source='$source'");
	_debug("xdev_move: dest='$dest'");

	_info("moving '$source' to '$dest'...");
	@opt = $::debug ? ("-v") : ();
	system("mv", @opt, "$source", "$dest") == 0
		or return 0;

	return 1;
}

=item create_info($trash_dir, $orig_path) -> ($name, $fh, $path)

Securely create a .trashinfo file in $trash_dir with a basename similar
to that of $orig_path; return the new basename, a writable filehandle,
and for convenience the full path to the file.

=cut

sub create_info {
	my ($trash_dir, $orig_path) = @_;
	my $base = basename($orig_path);
	my $i = 0;
	my ($name, $fh, $info_path);
	while ($i < 1000) {
		$name = $i ? "$base-$i" : $base;
		$info_path = "$trash_dir/info/$name.trashinfo";
		if (sysopen($fh, $info_path, O_WRONLY|O_CREAT|O_EXCL)) {
			_debug("found free info_path='$info_path'");
			return ($name, $fh, $info_path);
		} elsif ($! == EEXIST) {
			_debug("'$name.trashinfo' already exists, trying next...")
				if ($i % 25 == 0);
		} else {
			_err("cannot create '$info_path' ($!)");
			return undef;
		}
		++$i;
	}
	_debug("giving up after $i failures");
	_err("cannot create .trashinfo file (too many items named '$base')");
	return undef;
}

=item write_info($fh, $orig_path)

Write the [Trash Info] block for $orig_path to a filehandle.

=cut

sub write_info {
	my ($info_fh, $orig_path) = @_;

	my $path = path_encode($orig_path);
	my $now = strftime("%Y-%m-%dT%H:%M:%S%z", localtime);

	print $info_fh "[Trash Info]\n";
	print $info_fh "Path=$path\n";
	print $info_fh "DeletionDate=$now\n";
}

=item pase_date($iso8601_str)

=cut

sub parse_date {
	my ($str) = @_;

	my $r = qr/^
		(\d+) - 0*(\d+) - 0*(\d+)
		T 0*(\d+) : 0*(\d+) (?: : 0*(\d+) )?
		(?: \+ \d{4} )?
		$/x;

	if (my @m = $str =~ $r) {
		my ($dy, $dm, $dd, $th, $tm, $ts, $tz) = map {int($_ // 0)} @m;
		return POSIX::mktime($ts, $tm, $th, $dd, $dm-1, $dy-1900);
	} else {
		return 0;
	}
}

=item read_info($file)

=cut

sub read_info {
	my ($info_path) = @_;

	my ($info_fh, $orig_path, $trash_time);

	if (!open($info_fh, "<", $info_path)) {
		_err("could not read \"$info_path\": $!");
		return;
	}
	for (<$info_fh>) {
		if ($. == 1 && !/^\[Trash Info\]$/) {
			_err("syntax error in \"$info_path\"");
			close($info_fh);
			return;
		} elsif (!defined($orig_path) && /^Path=(.+)$/) {
			$orig_path = path_decode($1);
		} elsif (!defined($trash_time) && /^DeletionDate=(.+)$/) {
			$trash_time = parse_date($1);
		}
	}
	close($info_fh);

	if (!$orig_path) {
		_err("missing Path= in \"$info_path\"");
		return;
	}

	return {
		info => $info_path,
		orig => $orig_path,
		date => $trash_time,
	};
}

sub find_unique {
	my ($base) = @_;
	my $path = $base;
	my $i = 1;
	while (-e $path) {
		$path = $base."-".$i++;
		_die("could not find unique name for \"$base\"") if $i > 1_000;
	}
	return $path;
}

sub restore_from_info {
	my ($info) = @_;

	my $info_path = $info->{info};
	my $orig_path = $info->{orig};

	my $trash_dir = dirname(dirname($info_path));
	my $info_base = basename($info_path, ".trashinfo");
	my $trashed_path = "$trash_dir/files/$info_base";

	_debug("- info: '$info_path'");
	_debug("  original: '$orig_path'");
	_debug("  trashed: '$trashed_path'");

	my $orig_dir = dirname($orig_path);
	if (!-d $orig_dir) {
		_debug("creating parent directory '$orig_dir'");
		make_path($orig_dir);
	}

	$orig_path = find_unique($orig_path);

	if (dev($orig_dir, 1) == dev($trash_dir, 1)) {
		if (rename($trashed_path, $orig_path)) {
			unlink($info_path);
			++$count;
			_info("restored '".abs2rel_down($orig_path)."'") if $verbose && !$quiet;
		} else {
			_die("failed to rename '$trashed_path': $!");
		}
	} else {
		if (xdev_move($trashed_path, $orig_path)) {
			unlink($info_path);
			++$count;
			_info("restored '$orig_path'") if $verbose && !$quiet;
		} else {
			_die("failed to copy '$trashed_path' to '$orig_dir'");
		}
	}
}

sub find_home_trash {
	return ($ENV{XDG_DATA_HOME} // $ENV{HOME}."/.local/share") . "/Trash";
}

=item find_trash_dir($orig_path)

Find the best trash directory to use, according to XDG Trash Dir spec.

 * $home_trash if same device
 * $root/.Trash/$UID if checks pass
 * $root/.Trash-$UID if exists or can create
 * $home_trash otherwise

=cut

sub find_trash_dir {
	my ($orig_path) = @_;
	_debug("finding trash directory for '$orig_path'");
	if (!file_name_is_absolute($orig_path)) {
		_die("BUG: find_trash_dir('$orig_path') called with relative path");
	}

	my $fdev = dev($orig_path);
	while (!defined $fdev) {
		$orig_path = dirname($orig_path);
		_debug("...path not found, using parent '$orig_path'");
		$fdev = dev($orig_path);
	}

	my $home_trash = find_home_trash();
	ensure($home_trash);
	my $hdev = dev($home_trash);

	if (!defined $fdev) {
		return undef;
	} elsif ($fdev == $hdev) {
		return $home_trash;
	} elsif ($orig_path =~ m{^(/net/\w+/home/\w+/)}) {
		_debug("Detected NFS home directory '$1'");
		my $dir = catdir($1, ".local/share/Trash");
		if (-d $dir && ! -l $dir && ensure($dir)) {
			_debug("Using trash at '$dir'");
			return $dir;
		}
	} else {
		my $root = find_root($orig_path);
		my $dir = catdir($root, ".Trash");
		if (-d $dir && ! -l $dir && -k $dir && ensure("$dir/$<")) {
			return "$dir/$<";
		}
		$dir = catdir($root, ".Trash-$<");
		if (-d $dir || ensure($dir)) {
			return $dir;
		}
	}
	return $home_trash;
}

=item trash($path)

Create a trashinfo file in the appropriate trash directory, then move
actual $path there. If move fails, delete trashinfo and explode.

=cut

sub trash {
	my ($path) = @_;
	_debug("trying to trash '$path'");

	if (!lstat($path)) {
		_err("not found: '$path'");
		return;
	}

	if ($interactive) {
		confirm("Kill file \e[33m$path\e[m?") || return;
	}

	# canonicalize path

	my $orig_path = my_abs_path($path);
	_debug("full path: '$orig_path'");

	if (!-l $orig_path && -d $orig_path && !-w $orig_path) {
		# moving a directory involves updating its ".." entry
		_err("no write permission to '$orig_path'");
	}

	# make sure we can write to parent

	my $parent_dir = dirname($orig_path);
	if (!-w $parent_dir) {
		_err("no write permission to parent directory '$parent_dir'");
	}

	# find the volume root and trash location

	my $vol_root = find_root($orig_path);
	_debug("volume root: '$vol_root'");

	my $trash_dir = find_trash_dir($orig_path);
	_debug("using trash '$trash_dir'");

	# create the trash directory and a .trashinfo file

	ensure($trash_dir);

	my ($name, $info_fh, $info_name) = create_info($trash_dir, $orig_path);
	if (!$info_fh) {
		_err("failed to move '$path' to trash");
		return;
	}

	# write the .trashinfo file first

	my $orig_path_rel = $orig_path;
	if ($trash_dir ne find_home_trash()) {
		_debug("writing relative Path for removable drive trash");
		$orig_path_rel = File::Spec->abs2rel($orig_path, find_root($orig_path));
	} else {
		_debug("writing absolute Path for home trash");
	}

	_debug("writing Path '$orig_path_rel'");
	write_info($info_fh, $orig_path_rel);

	# move or copy the actual file

	my $trashed_path = "$trash_dir/files/$name";
	if (dev($orig_path) == dev($trash_dir)) {
		_debug("renaming file on same device");
		_debug("... from '$orig_path'");
		_debug("... to '$trashed_path'");
		if (rename($orig_path, $trashed_path)) {
			++$count;
			_info("trashed '$path'") if $verbose && !$quiet;
		} else {
			my $err = "$!";
			_debug("rename failed, unlinking info '$info_name'");
			unlink($info_name);
			_die("failed to rename '$path': $err");
		}
	} else {
		_debug("moving file across devices");
		_debug("... from '$orig_path'");
		_debug("... to '$trashed_path'");
		if (xdev_move($orig_path, $trashed_path)) {
			++$count;
			_info("trashed '$path' to \$HOME") if $verbose && !$quiet;
		} else {
			_debug("xdev_move failed, unlinking info '$info_name'");
			unlink($info_name);
			_die("failed to copy '$path' to '$trash_dir'");
		}
	}

	# sync the .trashinfo

	close($info_fh);
}

sub ls {
	my ($dir, $match) = @_;
	my $dh;
	if (!opendir($dh, $dir)) {
		_err("could not read \"$dir\": $!");
		return;
	}
	my @files =
		map {"$dir/$_"}
		grep {!$match || $_ =~ $match}
		readdir($dh);
	closedir($dh);
	return @files;
}

sub untrash_last {
	my @infos;

	my $home_trash = find_home_trash();

	for my $trash_dir ($home_trash) {
		_debug("searching trash '$trash_dir'");
		if (!-d "$trash_dir/info" || !-d "$trash_dir/files") {
			_debug("trash directory does not exist, skipping");
			next;
		}

		my $vol_root = find_root($trash_dir);
		_debug("volume root: '$vol_root'");

		for my $info_path (sort + ls("$trash_dir/info", qr/\.trashinfo$/)) {
			_debug("examining '$info_path'");
			my $info = read_info($info_path);
			if (!$info) {
				next;
			}
			_debug("  Path: $info->{orig}");

			if ($trash_dir ne $home_trash && $trash_dir !~ m!^/net/ember/home/grawity/\.local/share/!) {
				if (file_name_is_absolute($info->{orig})) {
					_warn("absolute Path= in '$info_path' is not permitted outside home ($trash_dir), skipping");
					next;
				}
				$info->{orig} = catdir($vol_root, $info->{orig});
				_debug("  full: $info->{orig}");
			}

			_debug("found \"$info->{orig}\" time $info->{date}");
			push @infos, $info;
		}
	}

	if (!@infos) {
		_err("no matching files in trash");
		return;
	}

	@infos = sort {$b->{date} <=> $a->{date}} @infos;
	_debug("candidate: $_->{date} (".interval($_->{date}).") $_->{info}") for $infos[0];

	my $info = $infos[0];
	my $age = interval($info->{date});
	if (@infos == 1) {
		_info("found one matching file ($age ago), restoring");
	} else {
		_info("found ".@infos." files, restoring most recent ($age ago)");
	}
	restore_from_info($info);
}

sub untrash {
	my ($path) = @_;
	_debug("trying to recover path='$path'");

	my $orig_path = my_abs_path($path);
	_debug("orig_path='$orig_path'");

	my $orig_dir = dirname($orig_path);
	_debug("orig_dir='$orig_dir'");

	my $vol_trash = find_trash_dir($orig_path);
	my $home_trash = find_home_trash();

	my @infos;

	if ($orig_dir eq "$home_trash/files") {
		my $trash_dir = $home_trash;

		_debug("direct trash info lookup (file is inside home trash)");
		my $info_path = catdir("$trash_dir/info", basename($orig_path).".trashinfo");

		_debug("examining '$info_path'");
		my $info = read_info($info_path);
		if (!$info) {
			return;
		}

		# NOTE: don't forget to re-add absolute-Path check if adding
		#       support for restoring from external .Trash directories

		_debug("found \"$info->{orig}\" time $info->{date}");
		push @infos, $info;
	} else {
		for my $trash_dir (uniq($vol_trash, $home_trash)) {
			_debug("searching trash '$trash_dir'");
			if (!-d "$trash_dir/info" || !-d "$trash_dir/files") {
				_debug("trash directory does not exist, skipping");
				next;
			}

			my $vol_root = find_root($trash_dir);
			_debug("volume root: '$vol_root'");

			for my $info_path (sort + ls("$trash_dir/info", qr/\.trashinfo$/)) {
				_debug("examining '$info_path'");
				my $info = read_info($info_path);
				if (!$info) {
					next;
				}
				_debug("  Path: $info->{orig}");

				if ($trash_dir ne $home_trash && $trash_dir !~ m!^/net/ember/home/grawity/\.local/share/!) {
					if (file_name_is_absolute($info->{orig})) {
					_warn("absolute Path= in '$info_path' is not permitted outside home ($trash_dir), skipping");
						next;
					}
					$info->{orig} = catdir($vol_root, $info->{orig});
					_debug("  full: $info->{orig}");
				}

				if (-d $orig_path) {
					my $info_orig_dir = dirname($info->{orig});
					next if $orig_dir ne $info_orig_dir;
				} else {
					next if $orig_path ne $info->{orig};
				}
				_debug("found \"$info->{orig}\" time $info->{date}");
				push @infos, $info;
			}
		}
	}

	if (!@infos) {
		_err("no matching files in trash");
		return;
	}

	@infos = sort {$b->{date} <=> $a->{date}} @infos;
	_debug("candidate: $_->{date} (".interval($_->{date}).") $_->{info}") for @infos;

	my $info = $infos[0];
	my $age = interval($info->{date});
	if (@infos == 1) {
		_info("found one matching file ($age ago), restoring");
	} else {
		_info("found ".@infos." files, restoring most recent ($age ago)");
	}
	restore_from_info($info);
}

sub usage {
	say for
	"Usage: $::arg0 [options] <file>...",
	"",                       #
	"  -f, --force            Ignored (compatibility with `rm`)",
	"  -i, --[no-]interactive Prompt before removing a file",
	"  -r, --recursive        Ignored (compatibility with `rm`)",
	"  -v, --[no-]verbose     Show files being removed",
	"",
	"      --find-trash       Only print the trash directory",
	"      --restore          Restore files from trash";
}

# Option parser

my $opt_du = 0;
my $opt_empty = 0;
my $print_path = 0;
my $restore = 0;
my $restore_last = 0;

GetOptions(
	'help'		=> sub { usage(); exit; },
	'du'		=> \$opt_du,
	'empty'		=> \$opt_empty,
	'find-trash!'	=> \$print_path,
	'f|force'	=> sub { },
	'i|interactive!'=> \$interactive,
	'q|quiet!'	=> \$quiet,
	'restore!'	=> \$restore,
	'restore-last!'	=> \$restore_last,
	'r|R|recursive'	=> sub { },
	'v|verbose!'	=> \$verbose,
) or exit 2;

if ($opt_du) {
	exit system("du", "-hs", find_home_trash());
} elsif ($opt_empty) {
	# yeah I'm lazy
	if (in_path("gio")) {
		exit system("gio", "trash", "--empty");
	} else {
		exit system("gvfs-trash", "--empty");
	}
}

if (!@ARGV) {
	_die("no files given") unless $restore_last;
}

# Main code

if ($print_path) {
	say find_trash_dir(my_abs_path($_)) // "(not found?)" for @ARGV;
} elsif ($restore_last) {
	untrash_last();
	_info("restored $count files") if (!$verbose && !$quiet);
} elsif ($restore) {
	untrash($_) for @ARGV;
	_info("restored $count files") if (!$verbose && !$quiet);
} else {
	trash($_) for @ARGV;
	_info("trashed $count files") if (!$verbose && !$quiet);
}

_exit();
